Clever-Excel-Forum

Hallo,

ich kopiere den Inhalt von 3 Spalten von dem ersten Blatt auf ein 2. Blatt.
Habe aber Probleme wenn eine Spalte keinen Inhalt hat und es kommt immer wieder ein Laufzeitfehler "Die Methode Paste für das Objekt ..... ist fehlgeschlagen.

Könnt Ihr mir bitte helfen?
Der kopiercode kommt von einer Macroaufnahme.
Kann man das vielleicht auch besser gestallten?

Vielen lieben DAnk für Eure Unterstützung, hier der Code:

Dim wsNew As Worksheet
Set wsNew = Worksheets.Add
With wsNew
.Name = ("Blatt1")
.Move After:=Sheets(Sheets.Count)
End With

'### Die Spalten J, R und S kopieren und in neues Blatt einfügen

Sheets("Bestelldaten").Select
Range("J7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Blatt1").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Blatt1").Select
ActiveWindow.ScrollRow = 4611
ActiveWindow.ScrollRow = 4595
ActiveWindow.ScrollRow = 4199
ActiveWindow.ScrollRow = 3798
ActiveWindow.ScrollRow = 3396
ActiveWindow.ScrollRow = 2863
ActiveWindow.ScrollRow = 2288
ActiveWindow.ScrollRow = 1839
ActiveWindow.ScrollRow = 1475
ActiveWindow.ScrollRow = 1211
ActiveWindow.ScrollRow = 863
ActiveWindow.ScrollRow = 667
ActiveWindow.ScrollRow = 472
ActiveWindow.ScrollRow = 277
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 92
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 8
Sheets("Bestelldaten").Select
Sheets("Bestelldaten").Range("R7").Select
ActiveWindow.SmallScroll Down:=-12
Range("R7:S7").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Blatt1").Select
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Columns("A:C").Select
ActiveSheet.Range("$A$1:$C$4608").RemoveDuplicates Columns:=Array(1, 2, 3), _
Header:=xlYes

Columns("A:C").Select
ActiveWorkbook.Worksheets("Blatt1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Blatt1").Sort.SortFields.Add Key:=Range( _
"A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Blatt1").Sort
.SetRange Range("A2:C4608")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Hallo

ersetze den Kopierteil bitte mal durch diesen Teil. Ich kopere nur die wirklich vorhnadenen Daten in Spalte J, R, S

mfg Gast 123

Code:
Dim lz1 As Long     'Variable für LastZell

'###  Die Spalten J, R und S kopieren und in neues Blatt einfügen

With Sheets("Bestelldaten")

    lz1 = .Cells(Rows.Count, "J").End(xlUp).Row0

    .Range("J7:J" & lz1).Copy

    wsNew.Range("A1").PasteSpecial xlPasteValues

    lz1 = .Cells(Rows.Count, "R").End(xlUp).Row

    .Range("R7:R" & lz1).Copy

    wsNew.Range("B1").PasteSpecial xlPasteValues

    lz1 = .Cells(Rows.Count, "S").End(xlUp).Row

    .Range("S7:S" & lz1).Copy

    wsNew.Range("C1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False

End With

Grüsse an die Kollegen, habe nur heute mal Internet ....

datenmaus

Gast 123