Kopier code verbessern - Druckversion +- Office-Fragen.de (https://office-fragen.de) +-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html) +--- Forum: Excel (https://office-fragen.de/forum-2.html) +--- Thema: Kopier code verbessern (/thread-23366.html)

Kopier code verbessern - PBCJürgen - 18.10.2021 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) RE: Kopier code verbessern - AlterDresdner - 18.10.2021 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 RE: Kopier code verbessern - PBCJürgen - 18.10.2021 Vielen Dank an AlteDresdner. Pefekt RE: Kopier code verbessern - AlterDresdner - 20.10.2021 Aber  gerne doch. Danke für Rückmeldung, ist selten geworden.