von Blatt1 versch. auf Blatt 2 kopieren, auch leere Felder

[datenmaus]

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

[Gast 123]

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 ....