Note: The other languages of the website are Google-translated. Back to English

Hoe voer je een macro tegelijkertijd uit over meerdere werkmapbestanden?

In dit artikel zal ik het hebben over het tegelijkertijd uitvoeren van een macro in meerdere werkmapbestanden zonder ze te openen. De volgende methode kan u helpen om deze taak in Excel op te lossen.

Voer een macro tegelijkertijd uit in meerdere werkmappen met VBA-code


Voer een macro tegelijkertijd uit in meerdere werkmappen met VBA-code

Om een ​​macro over meerdere werkmappen uit te voeren zonder ze te openen, past u de volgende VBA-code toe:

1. Houd de ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Klikken Invoegen > Moduleen plak de volgende macro in het Module Venster.

VBA-code: voer dezelfde macro uit op meerdere werkmappen tegelijk:

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

Opmerking:: Kopieer en plak in de bovenstaande code uw eigen code zonder de Sub kop en End Sub voettekst tussen de Met Workbooks.Open (xFdItem & xFileName) en Eindigt met scripts. Zie screenshot:

doc macro meerdere bestanden uitvoeren 1

3. Druk vervolgens op F5 sleutel om deze code uit te voeren, en een Blader venster wordt weergegeven, selecteer een map die de werkmappen bevat die u allemaal op deze macro wilt toepassen, zie screenshot:

doc macro meerdere bestanden uitvoeren 2

4. En klik dan OK knop, wordt de gewenste macro in één keer uitgevoerd van de ene werkmap naar de andere.

 


De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2021 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functies Gratis proefperiode van 30 dagen. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!
officetab onderkant

 

Heb je vragen? Stel ze hier. (43)
Rated 4.5 uit 5 · 1 ratings
Deze opmerking is gemaakt door de moderator op de site
Zeer nuttige macro, en het werkt prima, maar ik zou graag willen kunnen selecteren op welke bestanden uit die map ik de macro wil laten draaien? De bestanden worden niet automatisch in een aparte map gegenereerd en ik moet verschillende macro's uitvoeren op elke set bestanden uit die map en ze vervolgens terugzetten naar de oorspronkelijke map.
Deze opmerking is gemaakt door de moderator op de site
Ik heb de instructies gevolgd, maar krijg een compileerfout "Loop wihtout Do". Wat mis ik? Mijn macrocode is heel eenvoudig, verander gewoon de lettergrootte van opgegeven rijen. Werkt vanzelf. Dit is wat ik heb... help alstublieft

Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Met Workbooks.Open (xFdItem & xFileName)
'hier uw code'
Rijen ("2:8"). Selecteer
Met Selectie.Lettertype
.Naam = "Arial"
Maat = 12
.Doorstrepen = False
.Superscript = Onwaar
.Subscript = Onwaar
.OutlineFont = Onwaar
.Schaduw = Onwaar
.Onderstrepen = xlOnderstrepenStyleGeen
.Kleur = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Eindigt met
xBestandsnaam = map
Ringleiding
End If
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo, Yarto,
Je hebt het script "Eindigen met" aan het einde van je code gemist, de juiste zou dit moeten zijn:
Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Met Workbooks.Open (xFdItem & xFileName)
'hier uw code'
Rijen ("2:8"). Selecteer
Met Selectie.Lettertype
.Naam = "Arial"
Maat = 16
.Doorstrepen = False
.Superscript = Onwaar
.Subscript = Onwaar
.OutlineFont = Onwaar
.Schaduw = Onwaar
.Onderstrepen = xlOnderstrepenStyleGeen
.Kleur = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Eindigt met
Eindigt met
xBestandsnaam = map
Ringleiding
End If
End Sub

Probeer het alsjeblieft, ik hoop dat het je kan helpen!
Deze opmerking is gemaakt door de moderator op de site
Zeer nuttige macro, en het werkt geweldig, maar ik zou graag willen kunnen selecteren op welke bestanden uit die map ik de macro wil laten draaien? Ik heb bijvoorbeeld 4 bestanden in een map met andere Excel-bestanden en ik wil dat het alleen op die 4 specifieke bestanden draait. Hoe kan ik je macro aanpassen zodat ik die 4 bestanden uit die map kan kiezen?
Deze opmerking is gemaakt door de moderator op de site
Hallo, Joël,
Om dezelfde code in specifieke werkmappen te activeren, moet u de onderstaande code toepassen:

Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Dim xFB als string
Met Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Waar
.Filters.Wissen
.Filters.Voeg "excel", "*.xls*" toe
.Tonen
Als .SelectedItems.Count < 1 dan Sub afsluiten
Voor lngCount = 1 naar .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Als xBestandsnaam <> "" Dan
Met Workbooks.Open(Bestandsnaam:=xBestandsnaam)
'jouw code
Eindigt met
End If
Volgende lngCount
Eindigt met
End Sub

Probeer het alsjeblieft, ik hoop dat het je kan helpen!
Deze opmerking is gemaakt door de moderator op de site
bedankt, was erg behulpzaam
Deze opmerking is gemaakt door de moderator op de site
Hi!

Ik probeer mijn code in de jouwe in te voegen en wanneer ik de macro uitvoer, krijg ik het volgende bericht: Runtime-fout '429': ActiveX kan het object niet maken. Gelieve te adviseren over hoe het kan worden opgelost. Dank u!

Mijn code:

Stel RInput = Bereik ("A2:A21") in
Stel ROutput = Bereik ("D2:D22") in

Dim A() als variant
ReDim A(1 naar RInput.Rows.Count, 0)
A = RInput.Waarde2

Stel d = CreateObject ("Scripsting.Dictionary") in

Voor i = 1 Naar UBound(A)
Als d.Bestaat(A(i, 1)) Dan
d(A(i, 1)) = d(A(i, 1)) + 1
Anders
d.Voeg A(i, 1), 1 . toe
End If
Volgende
Voor i = 1 Naar UBound(A)
A(i, 1) = d(A(i, 1))
Volgende

RUitgang = A
Deze opmerking is gemaakt door de moderator op de site
Hallo, allereerst bedankt voor deze macro, het was precies wat ik zocht. Ik heb echter één probleem, is er een manier om elk venster te sluiten en op te slaan als het voltooid is. Ik heb een grote hoeveelheid bestanden en ik heb bijna geen RAM meer voordat de uitvoering is voltooid.
Deze opmerking is gemaakt door de moderator op de site
Ja, voeg hieronder uw volgende code toe als u wilt dat het bestand met dezelfde naam wordt opgeslagen:

'Het werkboek opslaan'
ActiveWorkbook.Opslaan
Deze opmerking is gemaakt door de moderator op de site
Hallo, Caitlin,
Misschien kan de onderstaande code u helpen, elke keer nadat u uw specifieke code hebt uitgevoerd, verschijnt er een prompt voor het opslaan van het bestand om u eraan te herinneren de werkmap op te slaan.

Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Dim xWB als werkboek
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Do While xFileName <> ""
Stel xWB = Workbooks.Open(xFdItem & xFileName) in
Met xWB
'hier uw code'
Eindigt met
xWB.Sluiten
xBestandsnaam = map
Ringleiding
End If
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hi!

Ik probeer mijn code in de jouwe in te voegen en wanneer ik de macro uitvoer, krijg ik het volgende bericht: Runtime-fout '429': ActiveX kan het object niet maken. Gelieve te adviseren over hoe het kan worden opgelost. Dank u!

Mijn code:

Stel RInput = Bereik ("A2:A21") in
Stel ROutput = Bereik ("D2:D22") in

Dim A() als variant
ReDim A(1 naar RInput.Rows.Count, 0)
A = RInput.Waarde2

Stel d = CreateObject ("Scripsting.Dictionary") in

Voor i = 1 Naar UBound(A)
Als d.Bestaat(A(i, 1)) Dan
d(A(i, 1)) = d(A(i, 1)) + 1
Anders
d.Voeg A(i, 1), 1 . toe
End If
Volgende
Voor i = 1 Naar UBound(A)
A(i, 1) = d(A(i, 1))
Volgende

RUitgang = A
Deze opmerking is gemaakt door de moderator op de site
Hallo,

Ik heb deze macro met succes gebruikt om NBA-bestanden op te maken voor de 30 teams, elk met een eigen boek. Gisteren kreeg ik een foutmelding en dat Module (macro) niet kan worden voltooid of verwijderd of bewerkt (om te worden opgeslagen). Het heeft mijn persoonlijke macrowerkmap beschadigd en Excel vrijwel onbruikbaar voor mij gemaakt. Het crasht de app elke keer dat ik probeer toegang te krijgen tot een macro vanuit een bestand. Excel-ondersteuning en Windows-ondersteuning zijn niet in staat geweest om dingen te repareren. Kun je helpen?
Deze opmerking is gemaakt door de moderator op de site
Hallo, Is er een manier waarop ik de bestandsbestemming in het script zelf kan definiëren. Ik wil proces 3 overslaan waar we door de specifieke map moeten bladeren.
Deze opmerking is gemaakt door de moderator op de site
Hallo, bedankt voor deze code. kun je me alsjeblieft vertellen hoe ik het resultaat kan krijgen van mijn macro waarvoor ik alle werkmappen op één blad heb geopend (het resultaat van elke werkmap op een rij)? en is er een manier om de naam van elke werkmap toe te voegen aan de rij met de gegevens uit de vorige stap?
Deze opmerking is gemaakt door de moderator op de site
Hi

Ik kreeg een 1004 runtime-fout: syntaxis is niet correct toen ik de volgende code uitvoerde, namelijk de Extend Office VBA om "een macro tegelijkertijd uit te voeren over meerdere werkmappen met VBA-code" met de Extend Office VBA "Verwijder alle benoemde bereiken met VBA-code" in de plaats uw codeslot:

Sub LoopThroughFiles()

Dim xFd als FileDialog

Dim xFdItem als variant

Dim xBestandsnaam als tekenreeks

Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in

Als xFd.Toon = -1 Dan

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

Do While xFileName <> ""

Met Workbooks.Open (xFdItem & xFileName)

' Sub VerwijderNamen()

'Update 20140314'

Dim xName als naam

Voor elke xName in Application.ActiveWorkbook.Names

xNaam.Verwijderen

Volgende


Eindigt met

xBestandsnaam = map

Ringleiding

End If

End Sub

Wat ik probeer te doen, is een macro uit te voeren die de benoemde bereiken verwijdert in acht werkmappen die zich in dezelfde map bevinden.

Trouwens, dit is de eerste keer dat ik iets van Extend Office heb gebruikt en het heeft niet gewerkt. Deze website heeft mij enorm geholpen.

Suggesties/opmerkingen worden zeer op prijs gesteld.

alc
Deze opmerking is gemaakt door de moderator op de site
Hallo, aldc,
Je code werkt goed in mijn werkmap, welke Excel-versie gebruik je?
Deze opmerking is gemaakt door de moderator op de site
Hallo, deze code is zo goed en nuttig. Ik gebruik het veel!

Tegenwoordig gebruiken we in mijn organisatie SharePoint om onze bestanden op te slaan. Is er een manier om deze code voor alle bestanden in een sharepoint-map te laten werken?
Deze opmerking is gemaakt door de moderator op de site
Hallo, bedankt voor deze code.
Is er een manier om ook door submappen te bladeren? Laten we zeggen dat ik één map heb en binnen de map nog tien mappen die elk een Excel-bestand bevatten.

Is er een manier om gewoon de primaire map te selecteren, zodat de code door al zijn submappen loopt?

Dank je.
Deze opmerking is gemaakt door de moderator op de site
Hallo, Darko, Als u een code wilt uitvoeren vanuit een map met de submappen, past u de volgende code toe: Sub LoopThroughFiles_Subfolders(xStrPath As String)
Dim xSFolderName
Dim xBestandsnaam
Dim xArrSFPath() als string
Dim xI als geheel getal
Als xStrPath = "" Sub afsluiten
xBestandsnaam = Dir(xStrPath & "*.xls*")
Do While xFileName <> ""
Met Workbooks.Open(xStrPath & xFileName)
'hier uw code'
Eindigt met
xBestandsnaam = map
Ringleiding
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Do While xSFolderName <> ""
Als xSFolderName <> "." En xSFolderName <> ".." Dan
If (GetAttr(xStrPath & xSFolderName) en vbDirectory) = vbDirectory Dan
xI = xI + 1
ReDim behouden xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xSFolderName = Dir
Ringleiding
Als UBound(xArrSFPath) > 0 dan
Voor xI = 0 Naar UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Volgende xI
End If
End Sub
Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
End If
End SubProbeer het eens, ik hoop dat het je kan helpen!
Deze opmerking is gemaakt door de moderator op de site
Is het naast bovenstaande code mogelijk om Excel-bestanden te openen in een chronologische volgorde die ik wilde?
Deze opmerking is gemaakt door de moderator op de site
Hallo allereerst hartelijk dank voor de macro, het is echt handig om mee te werken. Ik vroeg me af of we een manier hebben om de map in de onedrive via macro te vernieuwen. Zo ja, kunt u me laten weten wat ik hier kan doen om de bestanden in onedrive te vernieuwen met behulp van macroscript?
Deze opmerking is gemaakt door de moderator op de site
Hallo, heel erg bedankt voor dit script, ik werk heel goed voor mij, maar ik heb speciale behoeften: is er een manier om het script te wijzigen om mijn code toe te passen met bestandsnaamvoorwaarden EN in submappen?
Ik leg uit: ik ben een leraar en ik heb een Excel-oplossing gemaakt om de resultaten van studenten op te slaan en om docenten de mogelijkheid te geven deze te raadplegen. Hiervoor heb ik een bestand per schoolonderwerp en een bestand voor de verantwoordelijke klas, allemaal in een map per klas.
Dus als ik een bug of een optimalisatie vind, moet ik de wijzigingen in alle bestanden in alle submappen melden.
Maar aangezien alle bestanden niet hetzelfde zijn (verschillende subjets-organisatie), zou ik graag een manier willen om mijn code par voorbeeld toe te passen op alle bestanden met de naam "maths class" in alle submappen, of integendeel, om mijn code toe te passen op alle bestanden in submappen behalve alle bestanden met de naam "xyz". Bedankt !Fabrice
Deze opmerking is gemaakt door de moderator op de site
Uw gegeven code werkt niet met de volgende VBA, kunt u alstublieft helpenSub Bundles()

vWS dimmen als werkblad
Dim vA, vA2()
Dim vR zo lang, vSum zo lang, vC zo lang
vN zo lang dimmen, vN2 zo lang, vN3 zo lang

Stel vWS = ActiveSheet in
Met vWS
vR = .Cellen(Rijen.Aantal, 4).Einde(xlOmhoog).Rij
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim behouden vA2 (1 tot vSum, 1 tot 4)
vA = .Bereik ("A2:D" & vR)
Voor vN = 1 Naar vR - 1
Voor vN2 = 1 Naar vA(vN, 4)
vC = vC + 1
Voor vN3 = 1 tot 4
vA2(vC, vN3) = vA(vN, vN3)
Volgende vN3
Volgende vN2
Volgende vN
Eindigt met
vC = 1
Voor vN = 1 Tot vSom - 2
vA2(vN, 4) = vC
Als vA2(vN + 1, 2) = vA2(vN, 2) Dan
vC = vC + 1
vA2(vN + 1, 4) = vC
Anders
vA2(vN + 1, 4) = 1
vC = 1
End If
Volgende vN
Application.ScreenUpdating = False
Sheets.Add
Met ActiveSheet
vWS.Bereik("A1:D1").Kopieer.Bereik("A1:D1")
.Cellen(2, 1).Resize(vSum, 4) = vA2
Eindigt met
Application.ScreenUpdating = True

End Sub
Deze opmerking is gemaakt door de moderator op de site
Ik wil deze VBA in meerdere bladen in een map tegelijk uitvoeren. Kunt u alstublieft helpenSub Bundles()

vWS dimmen als werkblad
Dim vA, vA2()
Dim vR zo lang, vSum zo lang, vC zo lang
vN zo lang dimmen, vN2 zo lang, vN3 zo lang

Stel vWS = ActiveSheet in
Met vWS
vR = .Cellen(Rijen.Aantal, 4).Einde(xlOmhoog).Rij
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim behouden vA2 (1 tot vSum, 1 tot 4)
vA = .Bereik ("A2:D" & vR)
Voor vN = 1 Naar vR - 1
Voor vN2 = 1 Naar vA(vN, 4)
vC = vC + 1
Voor vN3 = 1 tot 4
vA2(vC, vN3) = vA(vN, vN3)
Volgende vN3
Volgende vN2
Volgende vN
Eindigt met
vC = 1
Voor vN = 1 Tot vSom - 2
vA2(vN, 4) = vC
Als vA2(vN + 1, 2) = vA2(vN, 2) Dan
vC = vC + 1
vA2(vN + 1, 4) = vC
Anders
vA2(vN + 1, 4) = 1
vC = 1
End If
Volgende vN
Application.ScreenUpdating = False
Sheets.Add
Met ActiveSheet
vWS.Bereik("A1:D1").Kopieer.Bereik("A1:D1")
.Cellen(2, 1).Resize(vSum, 4) = vA2
Eindigt met
Application.ScreenUpdating = True

End Sub
Deze opmerking is gemaakt door de moderator op de site
Ik heb geprobeerd de code uit te voeren, maar de fout "424: Object Required" verschijnt op de regel "With Workbooks.Open(xFdItem & xFileName)". Door dieper te kijken, lijkt het erop dat de Excel-werkmappen die zijn opgeslagen in de betreffende map niet worden weergegeven/bestaan ​​(wanneer het venster wordt geopend met de codeweergave en ik probeer de map te openen en niet te selecteren, is deze leeg). Hoezo?
Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Met Workbooks.Open (xFdItem & xFileName)
Spreadsheets.Toevoegen na:=ActiveSheet
Bladen ("Blad2"). Selecteer
Spreadsheets ("Blad2").Naam = "Master"
Bladen ("Master"). Selecteer
Bladen ("Master"). Verplaatsen voor: = Bladen (1)
Eindigt met
xBestandsnaam = map
Ringleiding
End If
End Sub


Kunt u mij alstublieft helpen dit probleem op te lossen?
Deze opmerking is gemaakt door de moderator op de site
Dit is mijn favoriete website met de absoluut duidelijkste instructies (meer dan welke YouTube-video dan ook) en ik kom er keer op keer op terug. Heel erg bedankt voor deze tutorials - je bent de redder in nood van een trieste afstudeerstudent.
Deze opmerking is gemaakt door de moderator op de site
Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Met Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selectie.Insert Shift:=xlToRight
ActiveCell.Selecteren
Eindigt met
xBestandsnaam = map
Ringleiding
End If
Einde sub, help alstublieft. Trouwens, mijn Excel-bestandsextensie is (.csv - "door komma's gescheiden") . en ik heb 500 Excel-bestanden in een map met een gemiddelde van ongeveer 500000 rijen in elke rij. Help alstublieft. Ik wil gewoon een kolom in elke werkmap invoegen
Deze opmerking is gemaakt door de moderator op de site
heb je ooit antwoord gekregen op je vraag? Ik probeer hetzelfde te doen met meer dan 3700 csv-bestanden. Ik hoef alleen maar 1 kolom (A) toe te voegen.
Deze opmerking is gemaakt door de moderator op de site
Hallo, behoeftige en Carly, Om uw probleem op te lossen, om de code voor meerdere CSV-bestanden uit te voeren, hoeft u alleen maar de .xls-bestandsextensie te wijzigen in .csv zoals hieronder getoonde code: Sub LoopThroughFiles()
Dim xFd als FileDialog
Dim xFdItem als variant
Dim xBestandsnaam als tekenreeks
Stel xFd = Application.FileDialog (msoFileDialogFolderPicker) in
Als xFd.Toon = -1 Dan
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Do While xFileName <> ""
Met Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selectie.Insert Shift:=xlToRight
ActiveCell.Selecteren
Eindigt met
xBestandsnaam = map
Ringleiding
End If
End SubProbeer het eens, ik hoop dat het je kan helpen!
Deze opmerking is gemaakt door de moderator op de site
Hallo, is het mogelijk om de macro alleen in de bladen van verschillende werkmappen met een specifieke naam uit te voeren? Bedankt!!
Deze opmerking is gemaakt door de moderator op de site
Hallo Sarah,
Sorry, er is geen goede oplossing voor het probleem dat u aankaart.
Dank je!
Er zijn nog geen reacties geplaatst
Laad meer
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0   Personages
Voorgestelde locaties

Volg ons

Copyright © 2009 - www.extendoffice.com. | Alle rechten voorbehouden. Aangedreven door ExtendOffice. | Sitemap
Microsoft en het Office-logo zijn handelsmerken of gedeponeerde handelsmerken van Microsoft Corporation in de Verenigde Staten en / of andere landen.
Beschermd door Sectigo SSL