bis zur letzten beschriebenen Zelle Copy

Forumthread: bis zur letzten beschriebenen Zelle Copy

20.01.2021 10:51:47

Costner

Hallo zusammen,
ich möchte folgendes per VBA automatisieren.: Ich habe in Tabelle 3 eine Liste, die Anzahl der Zeile ändern sich je nachdem wie es gebraucht wird. Die Aufgabe des Makros soll in den Bereich bis zur letzten beschriebenen Zelle (z.b. Spalte A) Kopien ausführen. mein erstellter Code ist aus vielen Foren zusammengebastelt worden. Der aktuelle Code führt das Kopieren in der Liste endlos durch ohne zu unterbrechen. Bitte um Unterstützung.
Aktuell sieht mein Code so aus:

Sub CommandButton10()
Dim nZeile As Integer
Dim vSpalte As Integer
Dim vZeile As Integer
Dim nSpalte As Integer
Dim vSheet As String
Dim nSheet As String
vSheet = "Tabelle3" ' quellTabellenBlatt
nSheet = "Tabelle2" 'ZielTabellenBlatt
vZeile = 9 'Startzeile
For vSpalte = 1 To Sheets(vSheet).Cells(vZeile, 200).End(xlUp).Column
Sheets(nSheet).Cells(3, 1) = Sheets(vSheet).Cells(vZeile, 2) 'Ort
Sheets(nSheet).Cells(3, 3) = Sheets(vSheet).Cells(vZeile, 3) 'Buchstabe
Sheets(nSheet).Cells(5, 3) = Sheets(vSheet).Cells(vZeile, 11) 'Einwohneranzahl
Sheets("Tabelle2").Range("A1:F16").Copy 'Kopie Baukasten (Vorlage)
With Sheets("Tabelle1")
.Range("A" & Cells(.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
vZeile = vZeile + 1
Next
End Sub

Siehe Datei im Anhang:
https://www.herber.de/bbs/user/143141.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: bis zur letzten beschriebenen Zelle Copy

20.01.2021 11:22:37

Herbert_Grom

Hallo,
baue das in deinen Code ein:

intLastRow = Cells(1048576, 1).End(xlUp).Row

Servus

AW: bis zur letzten beschriebenen Zelle Copy

20.01.2021 11:40:03

Nepumuk

Hallo Costner,
die verbundenen Zellen in Tabelle1 musst du löschen, sonst klappt das kopieren nicht. Wozu überhaupt verbundene Zellen? Die machen nur Probleme.
Teste mal:

Option Explicit

Sub CommandButton10()

    Dim vZeile As Long, nZeile As Long
    Dim vSheet As String
    Dim nSheet As String

    vSheet = "Tabelle3" ' quellTabellenBlatt
    nSheet = "Tabelle2" 'ZielTabellenBlatt

    nZeile = 2

    With Worksheets(vSheet)

        For vZeile = 9 To .Cells(.Rows.Count, 1).End(xlUp).Row

            Worksheets(nSheet).Cells(nZeile, 1) = .Cells(vZeile, 2) 'Ort
            Worksheets(nSheet).Cells(nZeile, 3) = .Cells(vZeile, 3) 'Buchstabe
            Worksheets(nSheet).Cells(nZeile, 5) = .Cells(vZeile, 11) 'Einwohneranzahl

            nZeile = nZeile + 1

        Next
    End With

    With Worksheets(nSheet)

        .Range(.Cells(1, 1), .Cells(.Rows.Count, 5).End(xlUp)).Copy 'Kopie Baukasten (Vorlage)

    End With

    With Worksheets("Tabelle1")

        Call .Paste(Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0))

    End With

    Application.CutCopyMode = False

End Sub

Gruß
Nepumuk

AW: bis zur letzten beschriebenen Zelle Copy

20.01.2021 11:42:11

Klaus

Hallo Costner,
da war ja einiges im argen in deinem Code. Probier es mal so:

Sub CommandButton10()
Dim nZeile As Integer
Dim vZeile As Long
Dim vSheet As Worksheet
Dim nSheet As Worksheet
Dim bSheet As Worksheet
Dim LetzteZeile As Long
Dim StartZeile As Long
Set vSheet = Sheets("Tabelle3") ' quellTabellenBlatt
Set nSheet = Sheets("Tabelle2") 'ZielTabellenBlatt
Set bSheet = Sheets("Tabelle1") 'Ausgabetabelle
StartZeile = 9 'Startzeile
LetzteZeile = vSheet.Cells(StartZeile, 1).End(xlDown).Row
For vZeile = StartZeile To LetzteZeile
nSheet.Cells(3, 1) = vSheet.Cells(vZeile, 2) 'Ort
nSheet.Cells(3, 3) = vSheet.Cells(vZeile, 3) 'Buchstabe
nSheet.Cells(5, 3) = vSheet.Cells(vZeile, 11) 'Einwohneranzahl
nSheet.Range("A1:F16").Copy 'Kopie Baukasten (Vorlage)
bSheet.Range("A" & bSheet.Cells(bSheet.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial Paste: _
=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next
End Sub

Wichtig: in Tabelle2!A16 muss IRGEND etwas stehen! Mach notfalls ein Leerzeichen rein.
Tipp: Schmeiß die ganzen verbundenen Zellen raus, das macht nur unnötig Ärger.
LG,
Klaus

AW: bis zur letzten beschriebenen Zelle Copy

20.01.2021 12:09:42

Costner

Vielen vielen Dank für all eure Unterstützung.
Der Code von Klaus M. ist genau das was ich brauche.
Danke nochmals und Danke Klaus M.
schönen Tag wünsche ich euch. *freu*

Beliebteste Forumthreads (12 Monate)

bis zur letzten beschriebenen Zelle Copy

Forumthread: bis zur letzten beschriebenen Zelle Copy

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

bis zur letzten beschriebenen Zelle Copy

Forumthread: bis zur letzten beschriebenen Zelle Copy

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread