Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1736to1740
1736to1740
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

nächste Zeile kopieren

Forumthread: nächste Zeile kopieren

nächste Zeile kopieren
27.01.2020 14:36:59
Fritz

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: nächste Zeile kopieren
27.01.2020 15:37:31
Lutz
Hallo Fritz,
indem Du die zweite Zeile im Code ergänzt, zwei Zeilen weiterspringst und die nächste Suchzeile überspringst: 
...
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
Gruß,
Lutz
Anzeige
AW: nächste Zeile kopieren
27.01.2020 23:28:14
Fritz
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
Anzeige
AW: nächste Zeile kopieren
28.01.2020 10:21:25
Fritz
die Formel am Ende war leider nicht ganz korrekt.
Sie müsste eher so lauten:
=WENN(ODER(UND(B3=B1;B4=B2);UND(B3B1;B3=B5));C2+1;1)
AW: nächste Zeile kopieren
27.01.2020 15:49:15
UweD
Hallo
- die Schleife können mM nach entfallen.
- dass er die Zeile unter der Zeile die TEST123... das ginge mit dem Resize(2,...

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
LG UweD
Anzeige
noch was...
27.01.2020 15:51:22
UweD
dann kannst du die Schleife auch mit "Step 2" laufen lassen
AW: noch was...
27.01.2020 16:24:42
Fritz
Hallo Uwe,
vielen DAnk für Deinen Support.
In der Zwischenzeit hatte ich mich bereits auf meine aktuelle Lösung eingeschossen.
Und bin ganz glücklich dass ich es jetzt komplett zum Laufen bekommen habe.
Danke dennoch
Fritz
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige