Preskoči na glavno vsebino

Kako zagnati makro hkrati v več datotekah delovnih zvezkov?

V tem članku bom govoril o tem, kako zagnati makro v več datotekah delovnega zvezka hkrati, ne da bi jih odprli. Naslednja metoda vam lahko pomaga pri reševanju te naloge v Excelu.

Zaženite makro istočasno v več delovnih zvezkih s kodo VBA


Zaženite makro istočasno v več delovnih zvezkih s kodo VBA

Če želite zagnati makro v več delovnih zvezkih, ne da bi jih odprli, uporabite naslednjo kodo VBA:

1. Držite tipko ALT + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. Kliknite Vstavi > Moduliin v mapo prilepite naslednji makro Moduli Okno.

Koda VBA: zaženite isti makro na več delovnih zvezkih hkrati:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Opombe: V zgornjo kodo kopirajte in prilepite svojo kodo brez spodaj naslov in End Sub noga med Z delovnimi zvezki.Open (xFdItem & xFileName) in Končaj s skripte. Oglejte si posnetek zaslona:

doc zaženi makro več datotek 1

3. Nato pritisnite F5 tipko za izvajanje te kode in a Brskanje okno se prikaže, izberite mapo, ki vsebuje delovne zvezke, za katere želite, da vsi uporabljajo ta makro, glejte posnetek zaslona:

doc zaženi makro več datotek 2

4. In nato kliknite OK gumb, se bo želeni makro izvedel naenkrat iz enega delovnega zvezka v drugega.

 

Najboljša pisarniška orodja za produktivnost

🤖 Kutools AI Aide: Revolucionirajte analizo podatkov na podlagi: Inteligentna izvedba   |  Ustvari kodo  |  Ustvarite formule po meri  |  Analizirajte podatke in ustvarite grafikone  |  Prikličite funkcije Kutools...
Priljubljene funkcije: Poiščite, označite ali identificirajte dvojnike   |  Izbriši prazne vrstice   |  Združite stolpce ali celice brez izgube podatkov   |   Krog brez formule ...
Super iskanje: Več kriterijev VLookup    Multiple Value VLookup  |   VLookup na več listih   |   Nejasno iskanje ....
Napredni spustni seznam: Hitro ustvarite spustni seznam   |  Odvisni spustni seznam   |  Večkrat izberite spustni seznam ....
Upravitelj stolpcev: Dodajte določeno število stolpcev  |  Premakni stolpce  |  Preklop stanja vidnosti skritih stolpcev  |  Primerjaj obsege in stolpce ...
Predstavljene funkcije: Mrežni fokus   |  Pogled oblikovanja   |   Velika vrstica formule    Upravitelj delovnih zvezkov in listov   |  Knjižnica virov (Samodejno besedilo)   |  Izbirnik datuma   |  Združite delovne liste   |  Šifriranje/dešifriranje celic    Pošljite e-pošto po seznamu   |  Super filter   |   Poseben filter (filter krepko/ležeče/prečrtano ...) ...
15 najboljših kompletov orodij12 Besedilo Orodja (dodajanje besedila, Odstrani znake,...)   |   50 + Graf Vrste (Gantt Chart,...)   |   40+ Praktično Formule (Izračunajte starost glede na rojstni dan,...)   |   19 vstavljanje Orodja (Vstavite kodo QR, Vstavi sliko s poti,...)   |   12 Pretvorba Orodja (Številke v besede, Pretvorba valut,...)   |   7 Spoji in razdeli Orodja (Napredne kombinirane vrstice, Razdeljene celice,...)   |   ... in več

Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa.  Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...

Opis


Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!

 

Comments (43)
Rated 4.5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hi there,

Hoping you can help me further. I am using this VBA, I used a recorded macro. It is just formatting workbooks and running a vlookup. but it is getting hung up on reopening the active sheet. I am assuming because it is referencing the file name??? It is giving me a runtime error for being out of range. Also, if I delete all of this scrolling it recorded, will it break it? thankyou for posting this, it will be an awesome help!

I have attached the full script below:

ub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
Cells.Select
Cells.EntireColumn.AutoFit
Range("C2").Select
Selection.ClearContents
Range("D2").Select
Selection.ClearContents
Range("C1").Select
Selection.ClearContents
Range("D1").Select
Selection.ClearContents
Range("C2").Select
Workbooks.Open Filename:= _
"S:\C_Sain\PPS Reports\New PPS Reports\Final Files\Connection folders\PY Totals .xlsm"
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=2
Windows("**.xlsxm").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'[PY Totals .xlsm]Sheet1'!C1:C3,3,0)"
Selection.AutoFill Destination:=Range("C2:C174")
Range("C2:C174").Select
Selection.Style = "Currency"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Wage Adj PY Per Diem"
Range("D4").Select
Columns("C:C").EntireColumn.AutoFit
Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'[PY Totals .xlsm]Sheet1'!C1:C4,4,0)"
Selection.AutoFill Destination:=Range("D2:D174")
Range("D2:D174").Select
Selection.Style = "Currency"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PY Total Est Payment"
Range("E3").Select
Columns("D:D").EntireColumn.AutoFit
Columns("G:G").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=3
Columns("M:M").Select
Selection.EntireColumn.Hidden = True
Columns("O:O").Select
Selection.EntireColumn.Hidden = True
Columns("P:P").Select
Selection.NumberFormat = "mmmm"
ActiveWindow.SmallScroll ToRight:=5
Columns("W:W").Select
Selection.Style = "Currency"
Columns("Y:Y").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=4
Columns("AA:AA").Select
Selection.EntireColumn.Hidden = True
Columns("AC:AC").Select
Selection.EntireColumn.Hidden = True
Columns("AE:AE").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=3
Columns("AG:AG").Select
Selection.EntireColumn.Hidden = True
Columns("AI:AI").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll ToRight:=5
Columns("AK:AK").Select
Selection.EntireColumn.Hidden = True
Columns("AM:AM").Select
Selection.EntireColumn.Hidden = True
Columns("AO:AO").Select
Selection.EntireColumn.Hidden = True
Columns("AQ:AQ").Select
Selection.EntireColumn.Hidden = True
Columns("AS:AS").Select
Selection.EntireColumn.Hidden = True
Columns("AU:AU").Select
Selection.EntireColumn.Hidden = True
Columns("AW:AW").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 26
ActiveWindow.SmallScroll ToRight:=2
Columns("AX:BC").Select
Selection.EntireColumn.Hidden = True
Range("BH1").Select
Selection.Style = "Currency"
Selection.Style = "Currency"
Columns("BH:BH").Select
Selection.Style = "Currency"
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 30
Range("BD1").Select
Columns("BD:BD").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 42
ActiveWindow.SmallScroll ToRight:=1
End With
xFileName = Dir
Loop
End If
End Sub
This comment was minimized by the moderator on the site
your code works very well.. Is there a way to run a macro on every excel file in a folder and skip the one's which are already completed? Attached is the code i am using..
TIA
This comment was minimized by the moderator on the site
your code works very well! thank you.. is there a way to run this code across all the excel files in a folder without prompting to select? and if certain excel files are already ran by macro need to exclude those files and continue with other files.
This comment was minimized by the moderator on the site
your code works very well! thank you.. is there a way to run this code across all the excel files in a folder without prompting to select? and if certain excel files are already ran by macro need to exclude those files and continue with other files.
This comment was minimized by the moderator on the site
Is there a way to run a macro on every sheet on every file in a folder? I tried to plug in your "Run Or Execute The Same Macro On Multiple Worksheets At Same Time With VBA Code" into this one and I got an "unexpected end sub" error. Is there a different way to do this? Thanks in advance.
This comment was minimized by the moderator on the site
Hello, Neil,
To run the same code in all sheets of the workbooks, please apply the below code:
Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xWShs As Sheets
    Dim xWSh As Worksheet
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                Set xWShs = .Worksheets
                For xF = 1 To xWShs.Count
                On Error GoTo FORNEXT
                Set xWSh = xWShs.Item(xF)
                'your code here
                
FORNEXT:
                Next
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Is there a way to run this across every sheet on every file? I tried combining the code you provided for running across multiple sheets with this one and I get an unexpected sub end error. Any guidance on this? Thanks in advance.
This comment was minimized by the moderator on the site
I am running the code and I get an error on this line

If xFd.Show = -1 Then

IT says:
Run-time error '91':
Object Variable or With block variable not set

Can anyone help with this? Thank you in advance.
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Hello, Jonathan
The code works well in my Excel, could you upload your Excel file here if you don't mind, so that we can check where the problem.
Thank you!
This comment was minimized by the moderator on the site
Hi skyyang ! Thanks in advance

Would it affect I'm working on Mac Excel, it's an uptodate version.

https://drive.google.com/drive/folders/1z5-ylALa261C62EE2BdmTLmYODXRE43E?usp=sharing
I made a sample folder from the 200+ documents I need to loop this through. It contains 3 documents.

I wanted to loop this code.

Sub Clean_add()
Sheets("tmp_tmp_0202").Select
Sheets("tmp_tmp_0202").Name = "Sheet1"
Worksheets("Sheet1").Activate
Set Rng = ActiveSheet.UsedRange
Blank_Cells_Column = 1
For I = Rng.Rows.Count To 1 Step -1
If Rng.Cells(I, Blank_Cells_Column) = "" Then
Rng.Cells(I, Blank_Cells_Column).EntireRow.Delete
End If
Next I
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C10").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = ActiveWorkbook.Name
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 4), Array(2, 1)), TrailingMinusNumbers:=True
Range("B1").Select
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("B1:B2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("B1:B2:B" & Range("C" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C" & Range("D" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
End Sub
This comment was minimized by the moderator on the site
Hello, Jonathan

I have tested your workbooks, the code works well. Maybe this code is only available for Microsoft Excel.
Sorry for the inconvenient.
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-test.png
This comment was minimized by the moderator on the site
Thanks skyyang . I tried it on Microsoft and had no issues! Thanks for checking!
This comment was minimized by the moderator on the site
Hi, is it possible to run the macro only in the sheets of different workbooks with a specific name? Thanks!!
This comment was minimized by the moderator on the site
Hi, Sara,
Sorry, there is no good solution to the problem you raised.
Thank you!
This comment was minimized by the moderator on the site
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
End With
xFileName = Dir
Loop
End If
End Sub,  please help . BTW, my excel files extension is (.csv - "comma delimited") . and I have 500 excel files in a folder with each row average of approx to 500000 number of rows .. Please Help . I just want to insert columnin each workbook
This comment was minimized by the moderator on the site
did you ever get an answer to your question? I am trying to do the same thing to over 3700 csv files. I just need to add 1 column (A).
This comment was minimized by the moderator on the site
Hi, needy and Carly,For solving your problem, to run the code for multiple CSV files, you just need to change the .xls file extension to .csv as below code shown:<div data-tag="code">Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
End With
xFileName = Dir
Loop
End If
End SubPlease try, hope it can help you!
This comment was minimized by the moderator on the site
This is my favorite website with the absolute clearest instructions (more so than any YouTube video) and I keep coming back to it time and again. Thank you so much for these tutorials - you are a sad grad student's lifesaver.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations