Daten umkopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Aufteile() Dim zQ As Long, zZ As Long, varA, ii As Integer With ActiveSheet Worksheets.Add Columns("A").NumberFormat = "@" Columns("C").NumberFormat = "@" While Not IsEmpty(.Cells(zQ + 1, 1)) zQ = zQ + 1 zZ = zZ + 1 Cells(zZ, 1).Resize(, 2) = .Cells(zQ, 1).Resize(, 2).Value If Not IsEmpty(.Cells(zQ, 3)) Then varA = Split(.Cells(zQ, 3), ",") Cells(zZ, 3) = varA(0) For ii = 1 To UBound(varA) zZ = zZ + 1 Cells(zZ, 1) = varA(ii) Next ii End If Wend End With End Sub

Option Explicit Sub Aufteile() Dim zQ As Long, zZ As Long, varA, ii As Integer With Worksheets("Tabelle1") Worksheets("Tabelle2").Activate Cells.ClearContents Columns("C").NumberFormat = "@" While Not IsEmpty(.Cells(zQ + 1, 1)) zQ = zQ + 1 zZ = zZ + 1 Cells(zZ, 1).Resize(, 2) = .Cells(zQ, 1).Resize(, 2).Value If Not IsEmpty(.Cells(zQ, 3)) Then varA = Split(.Cells(zQ, 3), ",") Cells(zZ, 3) = varA(0) For ii = 1 To UBound(varA) zZ = zZ + 1 Cells(zZ, 3) = varA(ii) Next ii End If Wend End With End Sub

Hi Jens,
wenn die ersten drei Spalten "wie sie sind" übertragen und die vierte Spalte gesplittet werden soll,
geht das so:


Option Explicit
Sub Aufteile2()
Dim zQ As Long, zZ As Long, varA, ii As Integer
With Worksheets("Tabelle1")
Worksheets("Tabelle2").Activate
Cells.ClearContents
Columns("C").NumberFormat = "@"
While Not IsEmpty(.Cells(zQ + 1, 1))
zQ = zQ + 1
zZ = zZ + 1
Cells(zZ, 1).Resize(, 3) = .Cells(zQ, 1).Resize(, 3).Value
If Not IsEmpty(.Cells(zQ, 4)) Then
varA = Split(.Cells(zQ, 4), ",")
Cells(zZ, 3) = varA(0)
For ii = 1 To UBound(varA)
zZ = zZ + 1
Cells(zZ, 4) = varA(ii)
Next ii
End If
Wend
End With
End Sub

Vergleich doch mal diesen Code mit dem vorigen - dann siehst du die Änderungen.
Das Auftrennen passiert mit der Split-Funktion (wie der Name schon sagt):
varA = Split(.Cells(zQ, 4), ",")
Damit wird der Text aus Zelle in Zeile Spalte zQ, Spalte 4 anhand des Trennzeichens "," aufgeteilt.
Das Ergebnis steht dann im Variant-Datenfeld varA.
varA besteht aus des Teilen varA(0), varA(1), ... bis varA(n)
n ist Ubound(varA), die Nummer des letzten Eintrags in varA.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Sub KopiereDaten() Dim Bereich As Range Dim Tab1 As Worksheet, Tab2 As Worksheet Set Tab1 = Tabelle1 Set Tab2 = Tabelle2 Application.ScreenUpdating = False For Each Bereich In Tab1.Range("A2:" & Tab1.Range("A65500").End(xlUp).Address) If Bereich > "" Then With Tab2.Range("A65500").End(xlUp).Offset(1, 0) Tab1.Rows(Bereich.Row).Copy .PasteSpecial Transpose:=True End With End If Next Bereich Set Tab1 = Nothing Set Tab2 = Nothing Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread