Alle Spalten auf einem Tabellenblatt X-Mal untereinander kopieren

Question

Hallo zusammen,

Vielleicht könnt ihr mir ja helfen. Soweit meine Ausgangslage: ich habe ein Excelldokument mit 10 (A-J) Spalten und ca 160 Zeilen (in den Zeilen hab ich einen Mix aus Text, Zahlen und Formeln. nun möchte ich jede Zeile (Ab Zeile 2) xMal (konkret 65x) untereinander kopieren, ist in diesem fall auch egal ob jede Zeile sich 65x wiederholt oder ob es das Blatt 65x kopiert. Ich habe in der Zeile 1 die Spaltenüberschriften mit Filter, diese braucht es mir also nicht zu kopieren.

Hat irgend jemand schon mal ein solches Makro gemacht oder hätte mir vielleicht einen anderen Tipp? Gibt es diese möglichkeit vielelicht auch mit Dialogfenster "bitte anzahl zum koppieren eingeben" oder sowas ähnliches?

Vielen Dank für eure Hiilfe...

Ich hoffe damit wisst Ihr was ich gerne machen würde...

Grüsse

Torty

Answer 1

Hallo Torty,

versuch es mal so:

Sub kopieren()

Dim arrCopy As Variant
Dim lngLZeile As Long
Dim strAntwort As String
Dim dblAnzahl As Double
Dim i As Long

strAnzahl = InputBox("Wieviel mal soll kopiert werden?", "Kopieren")
'Abbruch falls keine Eingabe erfolgt
If strAnzahl = "" Then
MsgBox "Abbruch, da keine Eingabe erfolgt ist!", 16, "Abbruch!"
Exit Sub
End If

'Abbruch, falls Eingabe keine Zahl ist
If IsNumeric(strAnzahl) = False Then
MsgBox "Abbruch, da Eingabe keine Zahl ist!", 16, "Abbruch!"
Exit Sub
End If

'Eingabe in Zahl umwandeln
dblAnzahl = CDbl(strAnzahl)

'letzte Zeile und Spalte ermitteln
lngLZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'zu koierende Daten in Array schreiben
arrCopy = ActiveSheet.Range(Cells(2, 1), Cells(lngLZeile, 10))

'Schleife zum Einfügen
For i = 1 To dblAnzahl
'letzte Zeile ermitteln und um 1 erhöhen
lngLZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'einfügen
ActiveSheet.Range(Cells(lngLZeile, 1), Cells(lngLZeile + UBound(arrCopy, 1) - 1, 10)) = arrCopy
Next i

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.

Das Passt wieder einmal perfekt und funktioniert auch so. ich danke dir herzlich!

Super wenn man sich bei grossen und kleinen Problemen an jemanden so kompetentes wenden kann.

Grüsse

Torty