Hallo ihr lieben,
ich muss leider noch einmal nerven. Ich finde meinen Fehler nicht.
Ich habe eine Datei, in der ich einen temporären Reiter einfüge in dem ich aus einer zweiten Datei Daten rauskopieren möchte. Das mache ich deshalb, weil es sich um mehrere tausend zeilen handelt und Excel nicht immer zwischen beiden Dateien springen soll. Ich habe das Öffnungsszenario genauso gemacht, wie ich das bei anderen Dateien gemacht habe und es funktioniert dort. Ich weiß nicht, warum es jetzt nicht funktioniert. Der Makrorekorder würde es auch nicht wirklich anders machen.
Vielleicht könnt ihr mir helfen.
LG Markus
ps. der Code geht noch weiter, aber ich komme aktuell nicht über den Laufzeitfehler hinaus
Sub seriennummern_holen()
Dim neuegibonummer As String
Dim altegibonummer As String
Dim altegibonummer2 As String
Dim startnummeraaltegibo1 As String
Dim endnummeraaltegibo1 As String
Dim startnummerbaltegibo1 As String
Dim endnummerbaltegibo1 As String
Dim startnummeraaltegibo2 As String
Dim endnummeraaltegibo2 As String
Dim startnummerbaltegibo2 As String
Dim endnummerbaltegibo2 As String
Dim nametrackingliste As String
Dim bereich As Range
Dim zelle As Range
Dim pfad As String
Dim bereichtrackingliste As Range
Dim zelletrackingliste As Range
Dim blatt As String
Dim Suchbegriff As String
Dim letztezeilenachverfolgung As Long
Dim letztezeiletrackingliste As Long
Dim bereichkopieren As Range
'neues temporären Reiter einfügen -----------------------------------------------------------------------'
Sheets.Add
ActiveSheet.Name = "Kopie"
nametrackingliste = Cells(14, 17).Value
letztezeilenachverfolgung = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set bereich = Range(Cells(2, 1), Cells(letztezeilenachverfolgung, 1))
pfad = ThisWorkbook.Path
Suchbegriff = nametrackingliste
datei = Dir(pfad & "\" & "*" & Suchbegriff & "*" & ".xlsm")
On Error GoTo ende
'Trackingliste kopieren ------------------------------------------------------------------------------'
Application.DisplayAlerts = False
Debug.Print pfad & "\" & datei
blatt = "Tabelle1"
Workbooks.Open Filename:=(pfad & "\" & datei), ReadOnly:=True 'hier kommt der Laufzeitfehler 438
ActiveWorkbook.Sheets(blatt).Activate
letztezeiletrackingliste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set bereichkopieren = ActiveWorkbook.Range(Cells(1, 1), Cells(letztezeiletrackingliste, 6))
bereichkopieren.Copy Destination:=ThisWorkbook.Worksheets("Kopie").Range("A1")
ActiveWorkbook.Close
Application.DisplayAlerts = True
'Jede Zeile in der S-Nachverfolgung durchgehen und die Seriennummern aus der Trackingliste holen --------------------------------------------------------------'
Sheets("Kopie").Activate
letztezeiletrackingliste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set bereichtrackingliste = Range(Cells(2, 1), Cells(letztezeiletrackingsliste, 1))