Tabellenblatt aufteilen

[coemm]

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

[Winny]

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

[Crazy Tom]

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

[coemm]

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: 

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:

Index außerhalb des gültigen Bereichs

[Heinz Ulm]

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

[Heinz Ulm]

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

[Crazy Tom]

Hallo Conny

in meinem Test waren die Tabellenblätter schon vorhanden
hatte überlesen, dass die erst erstellt werden

MfG Tom

[coemm]

Hallo @all,

der Code:

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?

[schauan]

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.

[schauan]

.. 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.