Feld kopieren bis erste Leerzelle

Forumthread: Feld kopieren bis erste Leerzelle
4 Beiträge zu diesem Forumthread
Anzeige
VBA Beispiele zu verwandten Themen

Forumthread: Feld kopieren bis erste Leerzelle

31.08.2019 01:17:43

Thorsten

Hallo,
brauche eure Hilfe.
Im Feld D1:Q7 können Werte stehen. Diese möchte ich an eine darunterfolgende formatierte Tabelle übergeben. Funktioniert auch mit meinem bisherigen Code:
Sheets("SKU").Range("D1:Q7").Copy
With Application
.GoTo Cells(11, 4).End(xlDown).Offset(1, 0)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Problem:D1:Q7 ist das Maximum.
Es können auch weniger Datenzeilen sein, z.B. D1:Q4
Ich möchte nur soweit kopieren, bis die erste Leerzelle in Spalte D kommt.
Über Hilfe würde mich freuen.
Grüße Thorsten

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Feld kopieren bis erste Leerzelle

31.08.2019 03:09:15

GerdL
AW: Feld kopieren bis erste Leerzelle

31.08.2019 03:56:50

Thorsten
AW: Feld kopieren bis erste Leerzelle

31.08.2019 11:26:49

GerdL
funktioniert - Dankeschön

31.08.2019 15:02:17

Thorsten

AW: Feld kopieren bis erste Leerzelle

31.08.2019 03:09:15

GerdL

Hallo Thorsten!

Sub Makro2()
Sheets("SKU").Range("D1:Q" & Sheets("SKU").Range("D8").End(xlUp).Row).Copy
Sheets("SKU").Cells(11, 4).End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

Gruß Gerd

AW: Feld kopieren bis erste Leerzelle

31.08.2019 03:56:50

Thorsten

Guten Morgen :-) Gerd,
erst einmal vielen Dank.
Klappt prima, aber leider nur, wenn die Folgezelle in Spalte D wirklich leer ist.
Sorry, da habe ich leider nicht dran gedacht, nachstehndes mit aufzuführen.
Bei "Leerzelle" handelt es sich nicht um wirklich leer sonder ein Wenn, dann ""
und da kopiert es die Zellen trotzdem mit.
Gibt es dafür auch eine Möglichkeit?
Ich kann auch das "" mit 0 ersetzen, wenn das einfacher wäre.
Gruß Thorsten

AW: Feld kopieren bis erste Leerzelle

31.08.2019 11:26:49

GerdL

Hallo Thorsten!
Falls du keinen Flickenteppich in D1:D7 hast, z.B. so:

Sub Makro3()
Dim X As Long
If Sheets("SKU").Range("D1")  "" Then
X = 7
Do While Sheets("SKU").Cells(X, 4) = ""
X = X - 1
Loop
Sheets("SKU").Range("D1:Q" & X).Copy
Sheets("SKU").Cells(11, 4).End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub

Gruß Gerd

funktioniert - Dankeschön

31.08.2019 15:02:17

Thorsten

Hallo Gerd,
funktioniert, wie es soll :-)
Dankeschön
Gruß Thorsten