Szia!

Értelme az lenne, hogy a leggyakrabban használt keresésekhez nem kellene nyitogatni fájlokat, hanem függvényként jelen lennének. És ez 1 helyen lenne, amit több felhasználó használna bővítményként. (A listát kell frissíteni rendszeresen, így viszont mindenkinél naprakész lenne.)

Szia!

Köszi, ez így tényleg tök jó. Közben megcsináltam másként, ide rakom az egészet:
(Valamelyik oszlopban lévő értékek szerint szed szét egy fájlt több darabra)

Sub új_oszlop_szerint()

Dim wb, neva, el, mas, oszl As String

fej = InputBox(„Hány sornyi a táblázatod fejléce?”, „Fejléc megadása”, „1”)
neva = InputBox(„Milyen néven mentsem a fájlokat?”, „Fájlnév megadása”, „Darabolt”)
oszl = InputBox(„Melyik oszlop szerint válogassak? (Nagy betűvel add meg!)”, „Oszlop megadása”, „A”)

kulcs = oszl & (fej + 1)
Sheets(„Alap”).Select
Cells.Select
ActiveWorkbook.Worksheets(„Alap”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(„Alap”).Sort.SortFields.Add Key:=Range(kulcs), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Cells.Select
With ActiveWorkbook.Worksheets(„Alap”).Sort
.SetRange ActiveCell.CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

kezd = fej + 1
fejsor = 1 & „:” & fej
beill = kezd & „:” & kezd

Sheets(„Alap”).Select
Rows(fejsor).Select
Selection.Copy
Sheets(„Segéd”).Select
Rows(fejsor).Select
ActiveSheet.Paste
Sheets(„Alap”).Select

Do
Sheets(„Alap”).Select
i = kezd

Do

el = oszl & i
elso = Range(el).Value
mas = oszl & i + 1
masik = Range(mas).Value
i = i + 1

Loop Until elso <> masik

‘kezd most még az eredeti érték
vege = i
masol = kezd & „:” & vege – 1

Sheets(„Alap”).Select
Rows(masol).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(„Segéd”).Select
Rows(beill).Select
ActiveSheet.Paste
‘hozzáigazítjuk a tartalomhoz
Cells.Select
Cells.EntireColumn.AutoFit

‘átmásoljuk új lapra ée lementjük:
wb = ActiveWorkbook.Path
Sheets(„Segéd”).Select
Sheets(„Segéd”).Copy

wb = wb & „\” & neva & ” ” & elso & „.xls”
ActiveWorkbook.SaveAs wb
ActiveWindow.Close

‘fejsort kivéve kitöröljük az adatokat
torol = (fej + 1) & „:” & vege
Sheets(„Segéd”).Select
Rows(torol).Select
Selection.ClearContents

kezd = i

Loop Until masik = „”

Sheets(„Segéd”).Select
Rows(fejsor).Select
Selection.ClearContents

Sheets(„Vezérlő”).Select

End Sub

Köszönöm, ezt már próbáltam, de azt mondja, a Send-et nem engedi.(Rutime error ‘-214722 960 (80040220)
A „SendUsing”konfigurációs érték érvénytelen.

Ez a kód maga (nyílván to és from kitöltve), persze sok mindent nem értek belőle 🙂

Sub CDO_Mail_Small_Text()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
‘ Dim Flds As Variant

Set iMsg = CreateObject(„CDO.Message”)
Set iConf = CreateObject(„CDO.Configuration”)

‘ iConf.Load -1 ‘ CDO Source Defaults
‘ Set Flds = iConf.Fields
‘ With Flds
‘ .Item(„http://schemas.microsoft.com/cdo/configuration/sendusing&#8221;) = 2
‘ .Item(„http://schemas.microsoft.com/cdo/configuration/smtpserver&#8221;) _
‘ = „Fill in your SMTP server here”
‘ .Item(„http://schemas.microsoft.com/cdo/configuration/smtpserverport&#8221;) = 25
‘ .Update
‘ End With

strbody = „Hi there” & vbNewLine & vbNewLine & _
„This is line 1” & vbNewLine & _
„This is line 2” & vbNewLine & _
„This is line 3” & vbNewLine & _
„This is line 4”

With iMsg
Set .Configuration = iConf
.To = „@.hu”
.CC = „”

.BCC = „”
.From = „@.hu”
.Subject = „New figures”
.TextBody = strbody
.Send

End With

End Sub