Új hozzászólás Aktív témák
-
Delila_1
veterán
válasz
smallmer
#3005
üzenetére
Vidd be az utvonal állandóba a saját útvonaladat, a *****-os sorban meg add meg a sablon fájlod-, és a benne lévő makró nevét.
Mivel sok fájlról van szó, hogy ne unatkozz közben, a státuszsorban kiírja 10 darabonként a másolások számát.Sub osszemasolo()
Dim FN As String, i As Integer
Dim FD, utvonal As String
Const utvonal = "D:\Főmappa\almappa\" 'jöhet a megnyitás, másolás"
ChDir utvonal
FN = Dir("*.xlsx")
Do While FN <> ""
i = i + 1
Workbooks.Open Filename:=FN, ReadOnly:=True
MsgBox "Itt másolgatunk", vbInformation
'A már kész makrót itt hívhatod meg: workbook("sablon_fájl.xltx").makró_neve *****
Workbooks(FN).Close False
FN = Dir()
If i Mod 10 = 0 Then Application.StatusBar = "Másolva: " & i & "db fájl!"
Loop
Application.StatusBar = False
MsgBox "Befejeződött az összemásolás", vbInformation, "Fájlok összemásolása"
ActiveWorkbook.Save
' ActiveWorkbook.Close
End Sub -
válasz
smallmer
#3002
üzenetére
Ok, akkor ez nem annyira járható út. De simán tudsz csinálni egy másik excelt, ami először betölti a sablon-t és utána a többi excelt.
Amennyiben a sablon fájlban publikus-ként van definiálva a funkció/szubrutin, amit el akarsz érni, akkor azt probléma nélkül meg tudod tenni másik fájlból is (csak fel kell venned a sablon fájlt referenciaként). -
válasz
smallmer
#3000
üzenetére
A legegyszerűbb lenne, ha a sablon makrója nyitná meg a 200 excel fájlt (darabra, vagy egyszerűen csak az adott helyen levő és szabálynak megfelelő nevű fájlokat), szépen megnyitná a munkalapokat, megnézné az adatokat és vagy copy/paste vagy adatmásolással átrakná a sablon fájlba (és az elmentené más néven).
Igazából szerintem ehhez mindent megtalálsz stackoverflow-n:
Open
Copy/Paste szűrve
Új hozzászólás Aktív témák
- Lenovo ThinkPad T14 Gen 1 i5-10210 / 16GB RAM/ 256GB NVMe SSD világítós EU bill, kiváló állapotban
- vizes GAMER PC - RYZEN 5 7600X / 32GB DDR5 / RTX 5070 12GB
- HP EliteBook 840 G7 i5-10210U / 16GB RAM / 256GB SSD Szép állapot, EU bill, gyári töltő
- A KINCS ! Új HP EliteBook 860 G10 Profi Fémházas Laptop -50% 16" i7-1355U 32/1TB FHD+ IPS MATT
- Dobozos DELL Inspiron 16 Fémházas Multimédiás Laptop 16" -30% Ryzen 7 8840U 8mag 16/1TB FHD+ IPS
- Xiaomi Redmi Note 11 Pro 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Lenovo ThinkPad // T - Széria // X1 carbon // X1 Yoga 2-in-1 // és a többiek... 3-12. gen.
- Apple iPhone 17 Pro Max Deep Blue 256GB használt újszerű 100% akku (36 ciklus) garancia 2029.01.
- RÉSZLETFIZETÉS.BANKMENTES.KAMATMENTES. Arena Racer szövet gamer szék
- RÉSZLETRE .OPCIONÁLIS. G.SKILL Trident Z5 Neo RGB 96GB (2x48GB) DDR5 6000MHz
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
