nächste Zeile kopieren

Hallo zusammen,
ich bin ein VBA - Neuling und versuche gerade ausgehend von meine täglichen Problemen VBA Codes zu erweitern.
Ich habe folgenden Code aus dem Forum mir angepasst, der auch grundsätzlich so funktioniert:
Sub Titel_umtragen()
Dim Zeile, maxZeilen, Spaltenbeginn, Spaltenende As Double
maxZeilen = 480
Spaltenbeginn = 1
Spaltenende = 200
For i = 3 To 4
Worksheets(i).Range("A3:GV145").Value = ""
Next i
Zeile = 2
For i = 2 To maxZeilen
If Worksheets("Transponiert").Cells(i, 4).Value = "TEST123" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("TEST123").Cells(Zeile, j).Value = Worksheets("Transponiert").Cells(i, j).Value
Next j
Zeile = Zeile + 1
End If
Next i
Jetzt würde ich gerne den obigen Code so erweitern, dass er die Zeile unter der Zeile die TEST123 enthält mit übernimmt.
Glücklicherweise beinhaltet diese Zeile nicht das Kriterium TEST1234.
Vielen Dank für euren Support
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

... Worksheets("TEST123").Cells(Zeile, j).Value = Worksheets("Transponiert").Cells(i, j).Value Worksheets("TEST123").Cells(Zeile+1, j).Value = Worksheets("Transponiert").Cells(i+1, j).Value Next j Zeile = Zeile + 2 i=i+1

Hallo Lutz,
super herzlichen Dank! Es hat funktioniert.
Ich habe Dein Input benutzt und habe ihn noch etwas erweitert.
Anbei der Code:

Sub Titel_umtragen()
Dim Zeile, maxZeilen, Spaltenbeginn, Spaltenende As Double
maxZeilen = 480
Spaltenbeginn = 1
Spaltenende = 200
For i = 3 To 4
Worksheets(i).Range("A3:GV200").Value = ""
Next i
Zeile = 3
For i = 3 To maxZeilen
If Worksheets("Transponiert").Cells(i, 4).Value = "TEST123" Then
For j = Spaltenbeginn To Spaltenende
Worksheets("TEST123").Cells(Zeile, j).Font.Bold = False
Worksheets("TEST123").Cells(Zeile, j).Value = Worksheets("Transponiert").Cells(i, j).Value
Worksheets("TEST123").Cells(Zeile - 1, j).Value = Worksheets("Transponiert").Cells(i - 1, j). _
Value
Worksheets("TEST123").Cells(Zeile - 1, j).Font.Bold = True
Next j
Zeile = Zeile + 2
i = i + 1
End If
Next i
Worksheets("TEST123").Columns("T:GV").NumberFormat = "hh:mm:ss"
Worksheets("TEST123").Columns("I:K").NumberFormat = "hh:mm:ss"
Worksheets("TEST123").Columns("C").Insert Shift:=xlToLeft
End Sub

Soweit so gut.
Ich nehme ja hier eigentlich immer 2 Zeilen mit, die zusammen gehören. Daher der Sprung "-1". Die untere Zeile jedoch bekomme ich immer im falschen Zellenformat übertragen. Es soll nicht "hh:mm:ss" sein, sonder Benutzerdefiniert: Standard. Im I-Net finde ich nix hierzu.
Wenn das getan ist wollte ich noch gerne in Spalte C in Zeile 2 eine 1, in Zeile 3 eine 2, und in Zeile 3 diese Formel: =WENN(B4=B2;C3+1;1). In Excel würde ich die einfach runter ziehen und dann würde es passen. Wie ich das in VBA hinbekomme...keine Ahnung.
Im Prinzip dann nach Spalte B aufsteigend sortieren, dann nach Spalte C aufsteigend sortieren und SPalte C wieder löschen.[Wobei ich ich das per Makrorekorder mir zusammen schustern kann].
Wenn du mir aber bei den obigen Schritten auf die Sprünge helfen könntest wäre ich dir sehr dankbar.
Viele Grüße
Fritz

For i = 2 To maxZeilen If Worksheets("Transponiert").Cells(i, 4).Value = "TEST123" Then With Worksheets("TEST123") .Cells(Zeile, Spaltenbeginn).Resize(2, Spaltenende - Spaltenbeginn + 1) = _ Worksheets("Transponiert").Cells(i, Spaltenbeginn).Resize(2, Spaltenende - _ Spaltenbeginn + 1).Value End With Zeile = Zeile + 2 End If Next i

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread