Kopieren und Einfügen in alle Dateien in einem Ordner

Ich versuche, ein Blatt aus einer Datei zu kopieren und dann in etwa 6 Dateien in einem eingerichteten Ordner in eine festgelegte Registerkarte einzufügen. Ich habe diesen Code, aber es funktioniert nur für die erste Datei in dem Ordner. Es erstellt aus irgendeinem Grund auch eine leere Arbeitsmappe. Irgendwelche Vorschläge?Kopieren und Einfügen in alle Dateien in einem Ordner

Sub LoopThroughFiles() 

Dim wbk As Workbook 
Dim Filename As String 
Dim FirstFile As String 
Dim FileDirectory As String 
Dim x As Workbook 

Set x = Workbooks.Open("test.xlsx") 


With Application.FileDialog(msoFileDialogFolderPicker) 

    .Title = "Please select a folder" 
    .AllowMultiSelect = False 
    .Show 

    If .SelectedItems.Count = 0 Then 
     MsgBox "You did not select a folder" 
     Exit Sub 
    Else 
     FileDirectory = .SelectedItems(1) & "\" 
    End If 

End With 

Set wbk = Workbooks.Add 


Filename = Dir(FileDirectory) 
FirstFile = Filename 



Do Until Filename = "" 

    Dim new_wb As Workbook 
Set new_wb = Workbooks.Open(FileDirectory & Filename) 



If FirstFile = Filename Then 

    x.Sheets("report").UsedRange.Copy 

    new_wb.Sheets("roster").Range("a1").PasteSpecial 




End If 


new_wb.Close savechanges:=True 
Filename = Dir 

Loop 

MsgBox "All store totals have been added" 

End Sub

Quelle

2016-10-10 chasedcribbet

(a) Ihre Linie' Wenn FirstFile = Dateiname Then' ist speziell das Makro nur sagen, tut das Kopieren/Einfügen, wenn es die erste Datei in dem Ordner befindet. (b) Ich bin mir nicht sicher, warum es eine leere Arbeitsmappe erstellen würde - wie lautet der Dateiname der leeren Arbeitsmappe? – YowE3K

(b) Ihre Zeile 'Set wbk = Workbooks.Add' erstellt eine neue leere Arbeitsmappe. Da in den folgenden Zeilen kein Bezug zu wbk besteht, könnten Sie diese Zeile wahrscheinlich löschen. –

Ich habe das letzte Nacht herausgefunden. Ich fügte auch eine kleine Falte für die durchgeführten Aktionen hinzu. Ich bin neu in der Sicht, also wenn mir jemand sagen könnte, wie man den aktualisierten Code hinzufügt, werde ich es tun. Es maximiert die Zeichen für diese Antwort, wenn ich versuche, es hier zu kopieren. – chasedcribbet

Sub LoopThroughFiles_Paste_Roster()

Dim WBK Als Workbook ‚New Arbeitsmappe wird den Daten hinzugefügt, um Dim Dateiname As String Dim FirstFile As String Dim Filedirectory As String Dim x As Workbook Dim y als Arbeitsbuch

Set x = Workbooks.Open ("Copy Doc 1") Set y = Workbooks.Open ("Copy Doc 2")

'die Box Ordner Picker Dialog anzuzeigen, so Benutzer einen Ordner Mit Application.FileDialog (msoFileDialogFolderPicker) auswählen können

.Title = "Please select a folder" 
.AllowMultiSelect = False 
.Show 

If .SelectedItems.Count = 0 Then 
    MsgBox "You did not select a folder" 
    Exit Sub 
Else 
    FileDirectory = .SelectedItems(1) & "\" 
End If

End With

' rufen Sie den Namen der ersten Datei im Ordner mit Dir filename = Dir (Filedirectory) FirstFile = Dateiname

'Loop durch alle Dateien im Ordner ' öffnen Sie die Datei

Do Until Dateiname = ""

Set wbk = Workbooks.Open (Filedirectory & Dateiname, UpdateLinks: = False, Passwort: = "Password123")

With wbk 

    x.Sheets("report").UsedRange.Copy 

    wbk.Sheets("roster").Range("a1").PasteSpecial 

    y.Sheets("Setup").UsedRange.Copy 

    wbk.Sheets("PTO Taken and Req").Range("a1").PasteSpecial 


    End With

'speichern und schließen Sie die Datei ' erhalten die nächste Datei in den Ordner wbk.Close Savechanges: = True Dateiname = Dir

Schleife

MsgBox „Alle Seiten wurden „aktualisiert

End Sub

Quelle

2016-10-12 15:14:29 chasedcribbet

Kopieren und Einfügen in alle Dateien in einem Ordner

Antwort

Verwandte Themen