- Red Magic 11 Air – vékony házból süvít a szél
- Csíptetős fülesek csatája – Sony LinkBuds Clip vs. Huawei FreeClip 2
- Mérföldkő a szilárdtest-akkuknál: fontos lépést tett a QuantumScape
- Újabb óriásakku a Honortól: a X80 lehet a következő 10 000 mAh-s modell
- iPhone 18 Pro Max: kis kapacitásbővítés hoz nagy előrelépést üzemidőben
- Yettel topik
- Itt az első hivatalos poszter a Galaxy S26 Ultrához
- iPhone topik
- Fotók, videók mobillal
- Milyen okostelefont vegyek?
- Samsung Galaxy S10e - esszenciális
- OnePlus 15 - van plusz energia
- Minden út Palindrómába vezet: leépítésekkel tér vissza a Realme a gyökereihez
- Apple iPhone 15 - a bevált módszer
- Samsung Galaxy A54 - türelemjáték
Ú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
Új hozzászólás Aktív témák
- AMD 7500F Tray 2028 novemberig garanciával
- DJI NEO drón 3 akkumulátorral +tok +ND szűrők
- DELL PowerEdge R630 rack szerver - 2xE5-2650v3 (20 mag / 40 szál, 2.3/3.0GHz), 32GB RAM, 66921Ft+ÁFA
- -ÚJ- 2x8GB 3600MHz Apacer NOX hűtőbordás DDR4 kitek! GAR/SZÁMLA (a Te nevedre kiállítva)!
- Kingston HyperX Fury Beast 2x8GB 3200MHz DDR4 kit / Beszámítás OK!
- Honor Magic7 Lite 512GB, Kártyafüggetlen, 1 Év Garanciával
- ÚJ AKKU! Ár/ÉRTÉK BAJNOK! Dell Latitude 5330 i3-1215U 6mag! 16GB 512GB 13.3" FHD 1 év gar
- í kilenc! AKCIÓS PRECÍZIÓS KÉSZÜLÉK! 7560 i9-11950H 32GB RAM 1TB SSD Nvidia RTX A3000 6GB 1 év gar
- HP EliteOne 800 G4 All-in-One i5-8500 32GB 1000GB 23.8" Érintőkijelző!! 1 év garancia
- Telefon felvásárlás!! Xiaomi Redmi Note 13, Xiaomi Redmi Note 13 Pro, Xiaomi Redmi Note 13 Pro+
Állásajánlatok
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest


