Ich habe in 2 Verzeichnissen jeweils ca. 1500 Dateien in vielen Unterverzeichnissen.
Jetzt muss ich aus den Dateien des 1. Verzeichnises bestimmte Zellen auslesen und in die Dateien des 2. Verzeichnisses kopieren. Die Dateien des 2. Verzeichnisses unterscheiden sich durch den Zusatz "über 100" von den Dateien des 2. Verzeichnisses.
Ich kann Dateien des 1. Verzeichnisses auslesen und händeln - wie ich aber die Dateien aus dem 2. Verzeichnis einlesen und daraus bestimmte Zellen in die Dateien des 1. Verzeichnisses kopieren soll - habe ich bisher nicht herausgefunden.
Hier mein Ansatz:
Sub Makro_kopiere_Zellen_100()
Dim Mappe As Variant
Dim Mappe1 As Variant
Const LW = "D:\"
Const Pfad = "D:\users\caonix\Postwurf spezial\"
Const Pfad1 = "D:\users\caonix über100\Postwurf spezial\"
Const Verzeichnis = "D:\users\caonix\Postwurf spezial\"
Const Verzeichnis1 = "D:\users\caonix über100\Postwurf spezial\"
On Error GoTo Fehler
ChDrive LW
ChDir Pfad
'Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = Verzeichnis
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute() > 0 Then
For Each Mappe In .FoundFiles
' Debug.Print Mappe
Workbooks.Open Mappe
Sheets("PWurf Spezial").Select
' Mache den Pfad1 auf
' Hole die 1. Datei aus dem 1. Unterverzeichnis (Mappe1)
' Kopiere aus dem Sheet (PWurf) I19 bis I97
' Gehe zum Workbook Mappe
' Einfügen der Daten in C19 bis C97
' Schließe Mappe1 ohne Speichern
ActiveWorkbook.Close SaveChanges:=True
Next Mappe
End If
End With
Exit Sub
Fehler: MsgBox "O je, O je - ein Fehler"
Application.ScreenUpdating = True
End Sub