Salt la conținutul principal

Cum se execută o macrocomandă în același timp pe mai multe fișiere din registrul de lucru?

În acest articol, voi vorbi despre cum să rulați o macro pe mai multe fișiere din registrul de lucru în același timp, fără a le deschide. Următoarea metodă vă poate ajuta să rezolvați această sarcină în Excel.

Rulați o macrocomandă la fel în mai multe registre de lucru cu cod VBA


Rulați o macrocomandă la fel în mai multe registre de lucru cu cod VBA

Pentru a rula o macro pe mai multe registre de lucru fără a le deschide, vă rugăm să aplicați următorul cod VBA:

1. Țineți apăsat butonul ALT + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următoarea macro în fișierul Module Fereastră.

Cod VBA: Rulați aceeași macro pe mai multe registre de lucru în același timp:

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

notițe: În codul de mai sus, vă rugăm să copiați și să lipiți propriul cod fără Sub îndreptare și End Sub subsol între Cu Workbooks.Open (xFdItem & xFileName) și Se termina cu scripturi. Vedeți captura de ecran:

doc rulează macrocomenzi 1

3. Apoi apăsați F5 tasta pentru a executa acest cod și a Naviga fereastra este afișată, selectați un folder care conține registrele de lucru pe care doriți să le aplicați tuturor acestei macrocomenzi, consultați captura de ecran:

doc rulează macrocomenzi 2

4. Apoi faceți clic pe OK butonul, macrocomanda dorită va fi executată simultan de la un registru de lucru la altele.

 

Cele mai bune instrumente de productivitate de birou

🤖 Kutools AI Aide: Revoluționați analiza datelor pe baza: Execuție inteligentă   |  Generați codul  |  Creați formule personalizate  |  Analizați datele și generați diagrame  |  Invocați funcțiile Kutools...
Caracteristici populare: Găsiți, evidențiați sau identificați duplicatele   |  Ștergeți rândurile goale   |  Combinați coloane sau celule fără a pierde date   |   Rundă fără Formula ...
Super căutare: VLookup cu mai multe criterii    VLookup cu valori multiple  |   VLookup pe mai multe foi   |   Căutare fuzzy ....
Listă derulantă avansată: Creați rapid o listă derulantă   |  Listă drop-down dependentă   |  Listă derulantă cu selectare multiplă ....
Manager de coloane: Adăugați un număr specific de coloane  |  Mutați coloanele  |  Comutați starea vizibilității coloanelor ascunse  |  Comparați intervale și coloane ...
Caracteristici prezentate: Focus pe grilă   |  Vedere de proiectare   |   Big Formula Bar    Manager registru de lucru și foi   |  Biblioteca de resurse (Text automat)   |  Data Picker   |  Combinați foi de lucru   |  Criptare/Decriptare celule    Trimiteți e-mailuri după listă   |  Super Filtru   |   Filtru special (filtrează bold/italic/barat...) ...
Top 15 seturi de instrumente12 Text Instrumente (Adăuga text, Eliminați caractere,...)   |   50+ Diagramă Tipuri de (Gantt Chart,...)   |   40+ Practic Formule (Calculați vârsta pe baza zilei de naștere,...)   |   19 inserare Instrumente (Introduceți codul QR, Inserați imaginea din cale,...)   |   12 Convertire Instrumente (Numere la cuvinte, conversie valutara,...)   |   7 Merge & Split Instrumente (Rânduri combinate avansate, Celule divizate,...)   |   ... și altele

Îmbunătățiți-vă abilitățile Excel cu Kutools pentru Excel și experimentați eficiența ca niciodată. Kutools pentru Excel oferă peste 300 de funcții avansate pentru a crește productivitatea și a economisi timp.  Faceți clic aici pentru a obține funcția de care aveți cea mai mare nevoie...

Descriere


Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!

 

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