Makro liefert unterschiedliche Ergebnisse

[mikro87]

Hallo,

ich habe ein Makro, welches Dateien aus zwei Unterordner öffnen und sich von dort Daten ziehen soll.

Es kommt aber zu folgendem Problem:
Beim ersten ausführen zieht er sich alle Infos aus dem zweiten Ordner und nur die Daten aus der letzten Datei aus dem ersten Ordner.
Beim zweiten Durchlauf ist es dann umgekehrt

Hat jemand ne Idee?

Code:

Sub an()
   Dim FolderPathF As String, FolderPathUC As String, pathF As String, count As Integer, countUC As Integer, i As Integer, wks As Worksheet, ws As Worksheet, lrow As String, lrowUC As String, QG As String, j As Integer, x As Integer, y As Integer
  
   FolderPathF = ActiveWorkbook.Path & "\Funding\"
   FolderPathUC = ActiveWorkbook.Path & "\Unit Cost\"
  
   'Abfrage QG
   QG = "QG " & InputBox("Welches QG soll geladen werden?")
   'MsgBox QG
  
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
  
   pathF = FolderPathF & "\*.xlsx"
   pathUC = FolderPathUC & "\*.xlsx"
  
   'GoTo jump
  
   Filename = Dir(pathF)
   Do While Filename <> ""
      count = count + 1
      Filename = Dir()
   Loop
  
   For i = 1 To count
      Set wkbCopy = Workbooks.Open(FolderPathF & i & ".xlsx", UpdateLinks:=0)
      Worksheets("Funding " & QG).Activate
      lrow = Cells(Rows.count, 8).End(xlUp).Row
      lrow = "H8:AO" & lrow
      
      Worksheets("Funding " & QG).Range(lrow).Copy
      
      'Zurück zur "eigentlichen" Datei. Neues Blatt plus einfügen
      Application.ThisWorkbook.Activate
      
      'letzte Zeile ausfindig machen
      lrow = Cells(Rows.count, 8).End(xlUp).Row + 3
      'Cells(lrow, 8) = i & ".xlsx"
      
      'in die letzte Zeile einfügen
      Worksheets("Funding").Cells(lrow + 1, 8).PasteSpecial (xlPasteValues)
      
      'Blatt schließen ohne Speichern und ohne Zwischenablage
      Application.CutCopyMode = False
      Workbooks(i & ".xlsx").Close savechanges:=False
      Cells(lrow, 8).Font.Bold = True
   Next i
  
   Filename = Dir(pathUC)
   Do While Filename <> ""
      countUC = countUC + 1
      Filename = Dir()
   Loop
  
   For j = 1 To countUC
      Set wkbCopy = Workbooks.Open(FolderPathUC & j & ".xlsx", UpdateLinks:=0)
      Worksheets("Unit Cost " & QG).Activate
      lrowUC = Cells(Rows.count, 6).End(xlUp).Row
      lrowUC = "F8:AO" & lrowUC
      Worksheets("Unit Cost " & QG).Range(lrowUC).Copy
      
      'Zurück zur "eigentlichen" Datei. Neues Blatt plus einfügen
      Application.ThisWorkbook.Activate
      
      'letzte Zeile ausfindig machen
      lrowUC = Cells(Rows.count, 8).End(xlUp).Row + 2
      'Cells(lrowUC, 6) = j & ".xlsx"
      
      'in die letzte Zeile einfügen
      Worksheets("Unit Cost (Input)").Cells(lrowUC + 1, 6).PasteSpecial (xlPasteValues)
      
      'Blatt schließen ohne Speichern und ohne Zwischenablage
      Application.CutCopyMode = False
      Workbooks(j & ".xlsx").Close savechanges:=False
      Cells(lrowUC, 6).Font.Bold = True
   Next j
  
   Call F
  
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
  
   MsgBox count & " Funding-Datein verarbeitet" & vbNewLine & countUC & " Unit Cost-Datein verarbeitet"
  
End Sub

---

[Rabe]

Hi,

ich weiß nicht, ob es daran liegt, aber es fehlen ein paar Variablendeklarationen:
pathUC, Filename, wkbCopy

Darauf würdest Du hingewiesen, wenn Du vor das Makro "Option Explicit" schreiben würdest.
Das kann auch standardmäßig eingeschaltet werden:
Extras - Optionen
im Reiter "Editor" alle Haken setzen

[mikro87]

als was muss wkbCopy definieren?
Er sagt jetzt "Objekt erforderlich"

[Rabe]

Hi,

wenn ich es als Worksheet deklariere, läuft es ohne Fehlermeldung bis zum Aufruf der Sub F.

Ich weiß aber nicht, ob das dann das Richtige ist.
Sonst mal als Variant versuchen.

[Steffl]

Auch Hallo,

wenn ich es als Worksheet deklariere, läuft es ohne Fehlermeldung bis zum Aufruf der Sub F.

ich würde es eher als Workbook deklarieren

Code:

Set wkbCopy = Workbooks.Open(FolderPathUC & j & ".xlsx", UpdateLinks:=0)

[mikro87]

ich habe es jetzt mal hoch geladen
Bei mir wird die erste Datei aus Funding nicht mit kopiert

[mikro87]

es fehlte die Auswahl der Ziel Mappe :16: