schau mal, ob dieser Code das macht, was du möchtest. Falls ja, kann man (besser frau) dies auch einfacher programmieren.
Sub DatenInZwischenablage()
'Dim Speicher As dataobject
Dim Help
Dim x As Long
Dim z As Long
'Set Speicher = New dataobject
x = 1
z = 18
Do While Cells(z, 1).Value <> ""
Help = Cells(z, 1).Value
If Help <> Cells(z + 1, 1).Value Then
strTmp = Cells(z, 1).Value & ";" & Cells(z, 7).Value
'Speicher.SetText strTmp
'Speicher.PutInClipboard
'Sheets("Tabelle1").Select
'Cells(x, 1).Paste
Sheets("Tabelle2").Cells(x, 1) = strTmp
Help = Cells(z + 1, 1).Value
x = x + 1
z = z + 1
End If
x = x + 1
z = z + 1
Loop
'Sheets("Tabelle1").Select
'Columns("A:A").Select
'Selection.Copy
End Sub
|