bis zur letzten beschriebenen Zelle Copy

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

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

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

Beliebteste Forumthreads (12 Monate)

bis zur letzten beschriebenen Zelle Copy

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

bis zur letzten beschriebenen Zelle Copy

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

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread