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
[
attachment=765]
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
Vielen Dank
an AlteDresdner.
Pefekt
Aber gerne doch. Danke für Rückmeldung, ist selten geworden.