Kopier code verbessern

[PBCJürgen]

Hallo,
ich würde gerne eine Bereich prüfen ob Datum vorhanden, wenn ja dann den Bereich von bis kopieren und in eine andere Tabelle einfügen,
Prüfbereich wäre Tagesblatt J3:J35
kopieren nach Verzehr_Jahresübersicht ab a2:As2
Ein makro hab ich mit dem Recorder aufgezeichnet kopiert zwar alles hinterlässt aber nach kopieren lücken.
für eine hilfe wäre ich dankbar

Excel 2016

Gruß Jürgen


  Testmappe.xlsm (Größe: 1,05 MB / Downloads: 6)

[AlterDresdner]

Hallo Jürgen,
anbei eine korrigierte Fassung. Das zeilenweise Kopieren ist nicht optimal, aber zunächst besser nachvollziehbar.
Der Code lautet
Option Explicit 'ist wichtig, entdeckt Schreibfehler
Sub Übertragen()
'
' Übertragen Makro
Dim LastRow As Long, Aktrow As Long
  Application.ScreenUpdating = False 'um Bildschirmflackern zu vermeiden
    LastRow = Sheets("Verzehr_Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1
    'erste freie Zeile in Verzehr_Jahresübersicht
    'aus Tagesblatt oberer Bereich Kopieren
    Aktrow = 3
    While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
      Cells(Aktrow, 10).Resize(, 36).Copy
      Sheets("Verzehr_Jahresübersicht").Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
      LastRow = LastRow + 1
      Aktrow = Aktrow + 1
    Wend
    'Tagesblatt unterer Bereich Kopieren
    Aktrow = 22
    While IsDate(Cells(Aktrow, 10)) 'solange J mit Datum belegt
      Cells(Aktrow, 10).Resize(, 36).Copy
      Sheets("Verzehr_Jahresübersicht").Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
      LastRow = LastRow + 1
      Aktrow = Aktrow + 1
    Wend
        ' Kopieren beenden
    Application.CutCopyMode = False
   
    ' Hilfsfunktion wir wieder gelöscht
   
    Sheets("Tagesblatt").Select

    Range("b1").Value = Range("b1").Value + 1
    Range("K3:AP20,K22:AP35,AR3:AS20,AR22:AS35").Select
    Range("AR22").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("K3").Select
  Application.ScreenUpdating = True 'wieder einschalten
End Sub

[PBCJürgen]

Vielen Dank
an AlteDresdner.

Pefekt

[AlterDresdner]

Aber  gerne doch. Danke für Rückmeldung, ist selten geworden.