Aufteilen und leere Zeilen löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim s As Long With Sheets("Tabelle1") For s = 3 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 2 .Columns(1).Resize(, 2).Copy Sheets((s + 1) / 2).Cells(1, 1) .Columns(s).Resize(, 2).Copy Sheets((s + 1) / 2).Cells(1, 3) With Sheets((s + 1) / 2) Intersect(.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow, _ .Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow).Delete End With Next End With End Sub

Sub LeereZeileLoeschen() Dim rng As Range On Error Resume Next Set rng = ActiveSheet.Range("B2:C20").SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If Not rng Is Nothing Then rng.EntireRow.Delete Set rng = Nothing End Sub

Sub test() Dim s As Long With Sheets("Tabelle1") For s = 3 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 2 Intersect(Union(.Columns(1).Resize(, 2), .Columns(s).Resize(, 2)), _ .Columns(s).Resize(, 2).SpecialCells(xlCellTypeConstants).EntireRow).Copy Sheets((s + 1) / 2).Cells(1, 1).PasteSpecial xlPasteAll Next End With End Sub

HI
die Anzahl der Kategoriespalten geht hier in den Code ein:

Sub test()
Dim s As Long
With Sheets("Tabelle1")
For s = 3 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 2
Intersect(Union(.Columns(1).Resize(, 2), .Columns(s).Resize(, 2)), _
.Columns(s).Resize(, 2).SpecialCells(xlCellTypeConstants).EntireRow).Copy
Sheets((s + 1) / 2).Cells(1, 1).PasteSpecial xlPasteAll
Next
End With
End Sub

die Anzahl der Länderspalten geht hier in den Code ein:

Sub test()
Dim s As Long
With Sheets("Tabelle1")
For s = 3 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 2
Intersect(Union(.Columns(1).Resize(, 2), .Columns(s).Resize(, 2)), _
.Columns(s).Resize(, 2).SpecialCells(xlCellTypeConstants).EntireRow). _
Copy
Sheets((s + 1) / 2).Cells(1, 1).PasteSpecial xlPasteAll
Next
End With
End Sub

an diese stelle (s + 1) / 2) so umrechnen, dass die entsprechende Blattnummer berechnet wird.
die generelle Formel wäre:
(s - Schleifen-Startwert) / Step der Schleife + Indexnummer des ersten Blattes
ich habs im Codebeispiel etwas anders gerechnet.
Gruß Daniel

Sub test() Dim s As Long With Sheets("Tabelle1") For s = 3 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 11 Intersect(Union(.Columns(1).Resize(, 4), .Columns(s).Resize(, 2)), _ .Columns(s).Resize(, 11).SpecialCells(xlCellTypeConstants).EntireRow).Copy Sheets((s + 1) / 2).Cells(1, 1).PasteSpecial xlPasteAll 'Fehlermeldung ? Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Aufteilen und leere Zeilen löschen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Aufteilen und leere Zeilen löschen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread