-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Pakliman
tag
válasz
BEndre34
#47586
üzenetére
Szia!
Megoldható úgy is: az útvonalat a
ThisWorkbook.Pathfogja megadni a makróm elején:MFName = Dir(ThisWorkbook.Path & "\Jelenléti ##.##.xlsx")De egy másik lehetőség:
A kollégák választják ki a szükséges táblázatokat (hibakezelést itt sem csináltam!).
Az összesítő munkalapra teszel egy ActiveX CommandButton-t, aminek a kódja:Private Sub CommandButton1_Click()
Dim twb As Workbook: Set twb = ThisWorkbook
Dim fd As FileDialog
Dim i As Long
Dim MFName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*"
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
If .SelectedItems(i) Like "*\Jelenléti ##.##.xls*" Then
Workbooks.Open Filename:=.SelectedItems(i)
MFName = ActiveWorkbook.Name
ActiveWorkbook.Sheets(1).Copy Before:=twb.Sheets(1)
ActiveSheet.Name = Mid(MFName, 11, 6)
Workbooks(MFName).Close SaveChanges:=False
End If
Next i
End If
End With
End Sub
Új hozzászólás Aktív témák
- iPhone topik
- Minőségi ugrást hozhat a One új médiaboxa?
- sziku69: Szólánc.
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Spórolós topik
- Xiaomi 11 Lite 5G NE (lisa)
- Kínai tech-túra összefoglaló
- Kezdő fotósok digitális fényképei
- Linux kezdőknek
- További aktív témák...
- GYÖNYÖRŰ iPhone 13 mini 128GB Starlight -1 ÉV GARANCIA - Kártyafüggetlen, MS3832, 100% Akkumulátor
- LG 55UP76702LB 139 cm / 55 4K UHD Smart TV 6 hó garancia Házhozszállítás
- Lenovo ThinkPad T14S Gen1 Ryzen5 4650U 16GB
- ÁRGARANCIA! Épített KomPhone Ultra 9 285K 32/64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- Eredeti Lenovo 65W USB Type C notebook töltő
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő
Fferi50
