Excel Zelle mehrfach kopieren?

[pfeffis 11]

Hallo Gemeinde!

 

Ich weiß jetzt nicht ob ich mit dem Thema hier richtig bin aber ich probier dennoch mein Glück :).

 

folgendes Excel sheet:

Spalte 1 Spalte2

1 1

2 2

3 3

4 4

 

Ich möchte nun dass Zeile 1 5 mal, also

 

Spalte1 Spalte2

1 1

1 1

1 1

1 1

1 1

 

untereinander kopiert wird und dann genau das selbe mit zeile 2, 3, etc.

 

Ich hoffe ihr versteht was ich meine!? Das kopieren muss bestimmt in eine neue Excel Datei erfolgen und via Makro gelöst werden oder gibt es da etwas von Microsoft :)!?

Habe hierzu ein evtl. brauchbares Makro gefunden:

 

Sub CopyPrim()

Quelle = "Tabelle1"

Ziel = "Tabelle2"

Yziel = 1

 

With Sheets(Quelle)

'Durchlaufe alle Spalten der Quelle

For Xquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column

'Durchlaufe alle Zeilen der Quelle

For Yquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row

'Ist die Zelle leer?

If Not IsEmpty(.Cells(Yquelle, Xquelle)) Then

'Zellinhalt kopieren

Sheets(Ziel).Cells(Yziel, 1) = .Cells(Yquelle, Xquelle)

Yziel = Yziel + 1

End If

Next

Next

End With

End Sub

 

Nur wie sage ich ihm dass alles was in zeile 1 steht 5 mal identisch kopiert (untereinander) werden muss un mit allen nachfolgenden zeilen genau das selbe?

 

Vielen Dank vorab

 

 

Grüße

[Cybquest 36]

Unüberprüftwürde ich sagen, ändere den Codeteil folgendermassen:

If Not IsEmpty(.Cells(Yquelle, Xquelle)) Then
'Zellinhalt 5 x kopieren
For i=1 to 5
 Sheets(Ziel).Cells(Yziel, 1) = .Cells(Yquelle, Xquelle)
 Yziel = Yziel + 1
next
End If

[pfeffis 11]

Vielen Dank!

 

Jetzt schaut s aber leider noch so aus:

 

1

1

1

1

1

2

2

2

2

2

etc.

1

1

1

1

1

2

2

2

2

2

etc.

 

es soll aber

 

11

11

11

11

11

22

22

22

22

22

etc.

 

 

Er setzt Werte aus Spalte B drunter und nicht nebeneinander.

[Cybquest 36]

Stimmt. Mein Fehler (wie gesagt: unüberprüft ;)

Hier ne Lösung:

Sub CopyPrim()
Quelle = "Tabelle1"
Ziel = "Tabelle2"
Yziel = 1

With Sheets(Quelle)
'Durchlaufe alle Zeilen der Quelle
For Yquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
'Durchlaufe 5x alle Spalten der Quelle
For i = 1 To 5
For Xquelle = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
'Zellinhalt kopieren
Sheets(Ziel).Cells(Yziel, Xquelle) = .Cells(Yquelle, Xquelle)
Next
Yziel = Yziel + 1
Next
Next
End With
End Sub

[pfeffis 11]

Da kann ich nur sagen:

 

FETTES MERCI!!!