Hallo @all,
ich habe ein Tabellenblatt 1 mit 20 Spalten.
Wie schaffe ich es ohne großen Aufwand den Inhalt auf 18 neue Tabellenblätter zu kopieren,
wobei die Spalten A und B auf jedem Blatt vorhanden sein sollen und dazu jeweils eine weitere Spalte.
Also:
Tabellenblatt 2 mit den Spalten A, B, C
Tabellenblatt 3 mit den Spalten A, B, D
usw
Hi
so vielleicht?
Code:
Sub copySheet()
For i = 1 To 18
With Sheets(1)
Worksheets.Add After:=Sheets(Sheets.Count)
Union(.Range("A:B"), .Columns(i + 2)).copy Sheets(i + 1).Cells(1, 1)
End With
Next
End Sub
Hallo
zu starten aus Tabelle1
Code:
Sub test()
Dim i As Integer
Dim lngletzte As Long
lngletzte = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To 19
Sheets(i).Cells(1, 1).Resize(lngletzte, 2).Value = _
Cells(1, 1).Resize(lngletzte, 2).Value
Sheets(i).Cells(1, 3).Resize(lngletzte, 1).Value = _
Cells(1, i + 1).Resize(lngletzte, 1).Value
Next
End Sub
MfG Tom
Hallo Winni, hallo Tom,
danke für eure schnelle Rückmeldung.
@Winni,
dein Code funktioniert.
Ich musste ihn anpassen, da die ersten 3 Spalten fix bleiben sollten:
Zitat:Sub copySheet()
For i = 1 To 17
With Sheets(1)
Worksheets.Add After:=Sheets(Sheets.Count)
Union(.Range("A:C"), .Columns(i + 3)).Copy Sheets(i + 1).Cells(1, 1)
End With
Next
End Sub
@Tom,
bei deinem Code kommt folgende Meldung:
Zitat:Index außerhalb des gültigen Bereichs
Hy Conny.
probiers mal so mit VBA:
Sub test()
For I = 1 To 18
Buchstabe = Chr(66 + I)
Worksheets("Tabelle1").Range("A:B", Buchstabe & ":" & Buchstabe).Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Worksheets("Tabelle1").Columns("C:C").Copy
Columns(Buchstabe & ":" & Buchstabe).Copy
Next I
End Sub
Hey Conny,
das würde reichen.
Sub test()
For I = 1 To 18
Buchstabe = Chr(66 + I)
Worksheets("Tabelle1").Range("A:B", Buchstabe & ":" & Buchstabe).Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Next I
End Sub
Hallo Conny
in meinem Test waren die Tabellenblätter schon vorhanden
hatte überlesen, dass die erst erstellt werden
MfG Tom
Hallo @all,
der Code:
Zitat:Sub copySheet()
For i = 1 To 17
With Sheets(1)
Worksheets.Add After:=Sheets(Sheets.Count)
Union(.Range("A:C"), .Columns(i + 3)).Copy Sheets(i + 1).Cells(1, 1)
End With
Next
End Sub
verteilt die Spalten auf die Tabellenblätter so, wie ich es haben möchte.
Leider werden aber nicht die Breite der Seitenränder und auch nicht die Zeilenhöhen übernommen.
Wie muss ich den Code ergänzen, damit er mir noch den Tabellennamen aus den Zellen D1+","+D2 übernimmt?
Hallo Conny,
Wenn Du ein neues Blatt erstellst, ist es das aktive.
Du kannst also mit Activesheet.name = Sheets(..).Cells(2,4) & Sheets (...).Cells(4,4) das Blatt umbenennen. ... wäre der Name vom Blatt mit den Zellinhalten.
Du mußt aber aufpassen, Du kannst ja nicht 17 Blätter gleich benennen.
.. Ach w, ich vermute, du willst d2 und d4 aus dem eingefügten Bereich. Dann brauchst Du nur den Teil ab Cells.
Die Sheets brauchst du aber, um dann die Seitenränder zu übernehmen. Mehr dann morgen.