Hallo liebe Mitglieder,
ich versuche gerade aus mehreren Dateien von denen ich jeweils das zweite Arbeitsblatt ansprechen will eine Spalte in meine masterexcelfile zu kopieren. Der Kode funktioniert an sich auch aber komischerweise kopiert mir der Kode von einer der Datei die Spalte immer zwei mal rein und ich weiss nicht genau warum es eben nur bei dieser einen Datei geschieht und bei den anderen nicht.
Jede Datei(von 120) hat eine andere Endung und werden zu untershciedlichen Zeiten in den Ordner geladen, deshalb haben Array angelegt mit den jeweiligen Endungen.
sub einlesen()
'On Error Resume Next
'Definieren der Dateien
Dim newExcelfile As Workbook
Dim masterExcelfile As Workbook
Dim folderPfad As String
Dim filePfad As String
Dim currentColumn As Long
'Definieren der Standortbezeichnung als eine Zeichenfolge
Dim myArray(120) As String
Einfügen der Codes
myArray(1) = "WF822"
myArray(2) = "WF803"
myArray(3) = "B0420"
..
...
Pfad für den ordner Exceldateien
folderPfad = "C:\"
'Master Excel auf Variable setzen, damit man diese auch bei mehreren gleichzeitig
'geöffneten Exceldateien ansprechen kann
Set masterExcelfile = ActiveWorkbook
'
currentColumn = 5
For i = 1 To 120
'Mit der If-Abfrage testen, ob die Datei existiert; nur wenn sie existiert soll das Makro ausgeführt werden
If Len(Dir(folderPfad & "*" & myArray(i) & "*" & ".xlsx")) = 0 Then
'Datei existiert NICHT, also nichts tun und weiter in der For-Schleife
Else
'Datei existiert, also Datei öffnen und Spalte kopieren
filePfad = Dir(folderPfad & "*" & myArray(i) & "*" & ".xlsx")
Set newExcelfile = Workbooks.Open(folderPfad & filePfad)
'Hier nimmt er jetzt Spalte 1 des ersten Tabellenblattes und kopiert das in die NÄCHSTE FREIE Spalte des
'Tabellenblattes "Checkliste" deines Masters
newExcelfile.Worksheets(2).Columns(5).Copy Destination:=masterExcelfile.Worksheets("Checkliste").Columns(currentColumn)
'Dann die geöffnete Excel wieder schließen ohne diese zu speichern
'(wir haben ja nichts verändert)
newExcelfile.Close Savechanges:=False
'Und dann noch die Spalten mit dem Code beschriften
masterExcelfile.Worksheets("Checkliste").Cells(4, currentColumn) = myArray(i)
'Damit das nächste Mal wieder in die nächste freie Spalte geschrieben wird, die Variable um einen erhöhen
currentColumn = currentColumn + 1
End If
Next i
'Damit es keine Karteileichen gibt
Set masterExcelfile = Nothing
Set newExcelfile = Nothing
End Sub
Vielleicht hat ja einer von euch eine Idee warum er mir eine Datei immer doppelt einfügt und vor allem auch ohne diese mit dem Array zu beschriften.
Ich danke euch jetzt schon vielmals!
Viele Grüße
Michelle
|