AW: Stammdaten in benutzfreundliche Tabelle bringe
22.01.2006 18:02:13
Matthias
Hallo Alex,
den Code mal ins Tabellenmodul der Blattes mit den Adressen:
Sub Wandeln()
Const Zieltabelle = "Sheet2" 'ANPASSEN! VORSICHT, INHALT WIRD GELÖSCHT
Dim sh As Worksheet
Set sh = Sheets(Zieltabelle)
Dim lz As Long, lz2 As Long
lz = Cells(Rows.Count, 1).End(xlUp).Row 'kann auch manuell
'bestimmt werden, wenn darunter noch andere Daten folgen!
Dim z As Long, i As Long
z = 4 '4: Erste Zeile
Dim tmp As String
With sh
.Cells.ClearContents
.Cells(1, 1) = "Kd.Nr."
.Cells(1, 2) = "Anrede"
.Cells(1, 3) = "Name"
.Cells(1, 4) = "Ortsteil"
.Cells(1, 5) = "Straße"
.Cells(1, 6) = "Ort"
lz2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Do
.Cells(lz2, 1) = Cells(z, 1) 'Kd-Nr
.Cells(lz2, 2) = Cells(z, 2) 'Anrede
z = z + 1
.Cells(lz2, 3) = Cells(z, 2) 'Name
If Cells(z, 2).Offset(3, 0) <> "" Then
'Ortsteil:
z = z + 1
.Cells(lz2, 4) = Cells(z, 2) 'Ortsteil
End If
z = z + 1
.Cells(lz2, 5) = Cells(z, 2) 'Straße
z = z + 1
.Cells(lz2, 6) = Cells(z, 2) 'Ort
z = z + 2
lz2 = lz2 + 1
Loop Until z > lz
End With
End Sub
Gruß Matthias