Laufzeitfehler 1004: Paste-Methode...
24.03.2021 18:06:41
M11
Sub Verteile_Daten()
'Screen-Update ausschalten
Application.ScreenUpdating = False
Dim a, b, x As Integer
Dim d, e As Date
'Zähle Blätter
Dim ws_count As Integer
ws_count = ActiveWorkbook.Worksheets.count
Dim i As Integer
'Start ab Blatt 2: Daten_...
For i = 3 To ws_count
'Anzahl der zu kopierenden Zeilen je FNR
a = Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(Sheets(i).Range(" _
_
_
C:C")), Sheets(i).Range("C:C"), 0) - 5
'Anzahl der FNRs (Summe aller Tage / Summe Tage für eine FNR)
b = Application.WorksheetFunction.count(Sheets(i).Range("C:C")) / a
'Datum zum Abgleich
d = Application.WorksheetFunction.Max(Sheets(i).Range("C:C"))
For x = 0 To (b - 1)
'Bereich je FNR kopieren
Range(Sheets(i).Cells(6 + a * x, 3), Sheets(i).Cells(5 + (a * (x + 1)), 18)).Copy
'Datei der entsprechenden FNR deklarieren: Pfad ändern, wenn nötig
Dim Ordner, name, datei As String
Ordner = "G:\PRM\Reports\PassiveMandate_v2\"
name = Sheets(i).Cells(6 + a * x, 4).Value
datei = Ordner & name & ".xlsx"
'ausgewählte Datei öffnen und kopierte Zellen unterhalb der letzten Zeile einfügen ( _
sofern Daten noch nicht eingefügt)
Workbooks.Open (datei)
e = Application.WorksheetFunction.Max(Sheets("Rohdaten").Range("A:A"))
'Wenn Datum vorhanden, dann Datei schließen
If d = e Then
ActiveWorkbook.Close SaveChanges:=False
Else
'hier wird eingefügt, Formeln erweitert, Format übernommen, gespeichert und Datei _
geschlossen
Dim lastRow As Integer
lastRow = Sheets("Rohdaten").Cells(Rows.count, "A").End(xlUp).Row + 1
Sheets("Rohdaten").Paste Destination:=Sheets("Rohdaten").Cells(lastRow, 1)
Worksheets("Rohdaten").Activate
With Sheets("Rohdaten")
Set SourceRange = .Range(Cells(lastRow - 1, 17), Cells(lastRow - 1, 32))
Set FillRange = .Range(Cells(lastRow - 1, 17), Cells(lastRow + a - 1, 32))
SourceRange.AutoFill Destination:=FillRange
End With
Worksheets("Rohdaten").Range(Cells(lastRow - 1, 1), Cells(lastRow - 1, 16)).Copy
Worksheets("Rohdaten").Range(Cells(lastRow - 1, 1), Cells(lastRow + a - 1, 16)). _
PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=True
End If
Next x
Next i
'Screen-Update anschalten
Application.ScreenUpdating = True
End Sub
Hallo zusammen,
mit diesem Code habe ich bisher Daten von einer Excel-Dateien in eine andere Excel-Datei kopiert. Aus irgendeinem Grund läuft das Makro jetzt nur noch bis zum Einfügen, eingefügt wird nicht und ich erhalte folgenden Fehler:
Laufzeitfehler 1004: Die Paste-Methode dieses Worksheet-Objekts kann nicht ausgeführt werden. Meine Vermutung war, dass es an der Formatierung im Zielobjekt liegt. Habe schon alles Mögliche ausprobiert, aber es funktioniert nicht. Vielleicht hat jemand eine Idee, woran es liegen könnte. Bislang hatte der Code immer einwandfrei funktioniert und ich weiß leider nicht, was der Auslöser war, dass er nun nicht mehr funktioniert. Rückfragen gerne!
VG