Daten neu sortieren

[stepcke]

Hier mein noch unvollständiger und nicht funktionierender Code.
Noch nicht versucht habe ich die Trennung des Zellinhalts in Spalten.
Das geht auch mit Excel-Daten "Text in Spalten"


Sub DatenVerteilen()

Dim Tab_Ziel As Worksheet                                       ' Ziel Tabelle
Dim Tab_Basis As Worksheet                                    ' Basis (Daten) Tabelle(n) > 15
Dim i_Blatt As Integer                                              'TabellenZähler
Dim i_Ziel As Integer                                               ' Zeile in der neuen Tabelle
Dim i_Basis As Integer                                              ' Zeile in der Datentabelle
Dim SatzEnde As Integer                                          ' Letzte Zeile des Datensatzes für eine Zeile in der Ziel Tabelle
Dim Bereich As Range
Dim sBegriff As String

sBegriff = "Tel:"
i_Ziel = 2


For i_Blatt = 1 To ActiveWorkbook.Worksheets.Count - 1

    Set Tab_Basis = ActiveWorkbook.Worksheets(i_Blatt)
    For i_Basis = 1 To Tab_Basis.UsedRange.Rows.Count
        With Tab_Basis
        Set Bereich = .Range(.Cells(i_Basis, 1), .Cells(i_Basis + 3, 1))
        SatzEnde = Bereich.Find(what:=sBegriff, LookIn:=xlValues, LookAt:=xlWhole).Row
        End With
         

        If SatzEnde - iBasis < 3 Then
        Tab_Ziel.Cells(iZiel, 1) = Tab_Basis(i_Basis, 1)
        Tab_Ziel.Cells(iZiel, 3) = Tab_Basis(i_Basis + 1, 1)
        Tab_Ziel.Cells(iZiel, 6) = Tab_Basis(i_Basis + 2, 1)
        Else
        Tab_Ziel.Cells(iZiel, 1) = Tab_Basis(i_Basis, 1)
        Tab_Ziel.Cells(iZiel, 2) = Tab_Basis(i_Basis + 1, 1)
        Tab_Ziel.Cells(iZiel, 3) = Tab_Basis(i_Basis + 2, 1)
        Tab_Ziel.Cells(iZiel, 6) = Tab_Basis(i_Basis + 3, 1)
        Tab_Ziel.Cells(iZiel, 9) = Tab_Basis.Name
        End If
   
    i_Basis = SatzEnde
    Next i_Basis
           
Next i_Blatt


End Sub

---

Hallo Fennek,

ich habe "noch" keine Ahnung was du da wie machst aber es funktioniert.

Mal schauen ob ich meinen Code optimiert bekomme. (für alle Blätter)

Ich Danke dir vielmals für deine Unterstützung!

Gruß
Stefan

PS: unsere Post hatten sich überschnitten