Krissi helpen

Sub Datenkombienation()
'
' Datenkombienation Makro
'
' Tastenkombination: Strg+Umschalt+M
'
   Dim lQuellZeile As Long
   Dim lZielZeile As Long
   Dim lSpalte As Long
   Dim lSuchZeile As Long
   Dim oQuelle As Object
   Dim oZiel As Object
   Dim bFlag As Boolean
   Dim sVergleichQuelle As String
   Dim sVergleichZiel As String
   Dim Zelle As Range
   Dim Zaehler As Long
   Dim oTargetSheet As Object
   Dim oSheet As Object
   Dim lErgebnisZeile As Long
   Dim i As Long
   Dim z As Long
   Dim s As Long

     Set oQuelle = Sheets("SCL-90") 'Arbeitsblatt festlegen, auf dem die Daten kombiniert werden

     Set oZiel = Sheets.Add 'Neues Arbeitsblatt erstellen auf dem die Daten gespeichert werden
     lZielZeile = 2 'Neue Daten werden in der zweiten Zeile eingef?hrt

     Application.ScreenUpdating = False 'Flackern ausschalten

     '?berschriften eintragen
     For lSpalte = 1 To 90
         oZiel.Cells(1, lSpalte).Value = oQuelle.Cells(1, lSpalte).Value
     Next lSpalte

     'Konsolidierung
     For lQuellZeile = 2 To oQuelle.UsedRange.Rows.Count + oQuelle.UsedRange.Row - 1

         bFlag = False

         'Pr?fen ob Zeile schon vorhanden
         For lSuchZeile = 2 To oZiel.UsedRange.Rows.Count + oZiel.UsedRange.Row - 1
             sVergleichQuelle = ""
             sVergleichZiel = ""
             For lSpalte = 1 To 4
                 sVergleichQuelle = sVergleichQuelle & CStr(oQuelle.Cells(lQuellZeile, lSpalte).Text)
                 sVergleichZiel = sVergleichZiel & CStr(oZiel.Cells(lSuchZeile, lSpalte).Text)
             Next lSpalte
             If LCase(Trim(CStr(sVergleichQuelle))) = LCase(Trim(CStr(sVergleichZiel))) Then
                 bFlag = True
                 Exit For
             End If
         Next lSuchZeile

         'Pr?fergebnis entscheidet ob bereits vorhanden oder eine neue Zeile angelegt werden muss
         If bFlag = True Then 'Bereits vorhanden also nur anh?ngen
             oZiel.Cells(lSuchZeile, 5).Value = oZiel.Cells(lSuchZeile, 5).Text & _
                 ", " & oQuelle.Cells(lQuellZeile, 5).Text
         Else 'Zeile als neu unten anh?ngen
             For lSpalte = C1 To AC1
                 'Inhalt ?bertragen ein f?hrendes ' erzwingt die Text?bernahme!!!
                 For Each Zelle In oQuelle.Range("C1:AC1")
                 oZiel.Cells(Zaehler, 1) = Zelle
                 Zaehler = Zaehler + 30
             lZielZeile = lZielZeile + 1
              Next lZeile
                End If
         Next lSpalte

         End Sub