Makroaufnahme schlanker gestalten

[datenmaus]

Hallo,
ich habe folgendes Makro aufgenommen, klappt auch alles.
Ich habe jetzt aber gelesen das der Recorder sehr viel Müll dazu schreibt. Kann man das verkürzen.
Die Funktion ist folgende:
In Tabelle1 die Spalten J, R und S ab Zeile 7 komplett zu kopieren und nach Tabelle 2 ab A1 einfügen.

Hier die Makroaufnahme:

Sheets("Tabelle1").Select
Range("J7").Select

    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("A1").Select
  ActiveSheet.Paste
    Sheets("Tabelle2").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("Tabelle1").Select
    Sheets("Tabelle1").Range("R7").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("R7:S7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


Vielen Dank für eure Hilfe

[Werner.M]

Hallo,

ohne deinen Tabellenaufbau zu kennen, vielleicht so:

Code:

Public Sub aaa()
Dim loLetzte As Long

With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, "J").End(xlUp).Row
    .Range("J7:J" & loLetzte).Copy Worksheets("Tabelle2").Range("A1")
    loLetzte = .Cells(.Rows.Count, "R").End(xlUp).Row
    .Range("R7:S" & loLetzte).Copy Worksheets("Tabelle2").Range("B1")
End With

End Sub

Gruß Werner

[datenmaus]

Hallo,

ohne deinen Tabellenaufbau zu kennen, vielleicht so:

Code:

Public Sub aaa()
Dim loLetzte As Long

With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, "J").End(xlUp).Row
    .Range("J7:J" & loLetzte).Copy Worksheets("Tabelle2").Range("A1")
    loLetzte = .Cells(.Rows.Count, "R").End(xlUp).Row
    .Range("R7:S" & loLetzte).Copy Worksheets("Tabelle2").Range("B1")
End With

End Sub

Danke, perfekt. Auf Anhieb funktioniert.
Vielen Dank

Gruß Werner

---

Vielen Dank,

perfekt