Kopieren Sie Zellen auf alle Arbeitsmappen in einem Ordner mit VBA in Microsoft Excel
In diesem Artikel erstellen wir ein Makro zum Kopieren von Zellen in alle Arbeitsmappen in einem Ordner.
Wir haben einige Beispiel-Excel-Dateien als Rohdaten verwendet. Diese Dateien enthalten Anwesenheitsdaten der Mitarbeiter. Jede Datei enthält Datum, Mitarbeiter-ID und Namen der Mitarbeiter. Wir möchten allen Dateien im Ordner Header hinzufügen.
Beim Ausführen des Makros werden Daten im Bereich H8 bis J10 als Kopfzeile in alle Excel-Tabellen im Ordner eingefügt.
Code Erklärung
FolderPath = Sheet1.TextBox1.Value Der obige Code wird verwendet, um dem Textfeld einen Wert zuzuweisen, um die Variable zu erwähnen.
Dir (FolderPath & „* .xlsx“)
Der obige Code wird verwendet, um den Dateinamen der ersten Datei innerhalb des angegebenen Ordnerpfads abzurufen.
Während FileName <> „“
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName FileName = Dir ()
Wend Der obige Code wird verwendet, um ein String-Array zu erstellen. Es enthält Dateinamen aller Dateien im Ordner.
Workbooks.Open (FolderPath & FileArray (i))
Der obige Code wird zum Öffnen der angegebenen Arbeitsmappe verwendet.
SourceWB.Worksheets (1) .Range („H8: J10“). Kopieren Sie DestWB.Worksheets (1) .Range („A1: C3“)
Der obige Code wird verwendet, um den Header aus der Hauptarbeitsmappe in andere Arbeitsmappen zu kopieren.
Bitte folgen Sie unten für den Code
Option Explicit
Sub CopyingDataToFilesInFolder()
'Declaring variables
Dim FileName, FolderPath, FileArray() As String
Dim Count1, i As Integer
Dim SourceWB, DestWB As Workbook
'Getting folder path from the text box
FolderPath = Sheet1.TextBox1.Value
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Getting the file name from the folder
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Creating an array which consists of file name of all files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
Set SourceWB = ThisWorkbook
For i = 1 To UBound(FileArray)
'Opening the workbook
Set DestWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the required header
SourceWB.Worksheets(1).Range("H8:J10").Copy DestWB.Worksheets(1).Range("A1:C3")
'Closing the workbook
DestWB.Close True
Next
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Wenn dir dieser Blog gefallen hat, teile ihn mit deinen Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]