Transponieren
12.11.2003 12:52:14
Uwe
"Punkt1 von 18 (vom 29.10.2003) Letzte Aktualisierung: 06.11.2003"
Die Zeilen stehen in einer Tabelle in verschiedenen Zeilen untereinander. Das Datum ist jedoch verschieden. Diese möchte ich alle mit diesem Makro transponieren.
Sub KopiereTranspo()
Dim Zeile As Integer
DIm Punkt.... ???????? As String
Dim Telefon As String
Dim Email As String
Application.ScreenUpdating = False
Do Until ActiveCell.Value = Empty
If ActiveCell.Value = "Punkt...?????" Then 'Gross- und Kleinschreibung beachten!
Punkt...????? = ActiveCell.Offset(0, 1).Value
Zeile = ActiveCell.Row
Range("O2").Select
Do Until ActiveCell.Value = Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Punkt....?????
Range("A" & Zeile).Select
End If
If ActiveCell.Value = "Telefon" Then 'Gross- und Kleinschreibung beachten!
Telefon = ActiveCell.Offset(0, 1).Value
Zeile = ActiveCell.Row
Range("O2").Select
Do Until ActiveCell.Value = Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Telefon
Range("A" & Zeile).Select
End If
If ActiveCell.Value = "Email" Then 'Gross- und Kleinschreibung beachten!
Email = ActiveCell.Offset(0, 1).Value
Zeile = ActiveCell.Row
Range("P2").Select
Do Until ActiveCell.Value = Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Email
Range("A" & Zeile).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub
Kann mir jemand helfen?
Grüsse
