hei,

ich habe im tabellenblatt eine Tabelle mit der entsprechenden Formatierung eingefügt. Mein Code ist leider nicht ideal--> ich kopiere eine Zeile aus der Quelldatei, wähle dann die erste leere Zeile in der Tabelle an, füge hier dann den Text ein und füge eine Zeile ein (mit listrows.add) . Beim mehrmaligen Ausführen des Makros werden mehr Zeilen eingefügt als eigentlich notwendig. Da ich dieses Problem nicht beheben konnte, will ich diese überflüssigen Zeilen nun einfach löschen. Hier mein bissheriger Code: 'bin Anfänger

Sub Fahrzeugeintraege_zuordnen()
  Dim objWks    As Worksheet
  Dim nLastRow  As Long
  Dim strMsg    As String
  Dim Zellinhalt_Kennzeichen As String
  Dim Kennzeichen As String
  Dim i As Integer
  Dim erstefreieZeile As Long
      
'letzte beschriebene Zeile des Tabellenblattes finden

  Set objWks = ActiveWorkbook.Worksheets(1)

  With objWks
      If Application.WorksheetFunction.CountA(.Cells) > 0 Then
          On Error Resume Next
          nLastRow = .Cells.Find(What:="*", After:=.Cells(1), _
                LookIn:=xlFormulas, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
          nLastRow = nLastRow - 1
          If Err.Number = 0 Then
              strMsg = "Letzte Zeile mit Daten: " & nLastRow
          Else
              strMsg = "Laufzeitfehler '" & CStr(Err.Number)
              strMsg = strMsg & "':" & vbCr & Err.Description
          End If
          On Error GoTo 0
      Else
          strMsg = "Das Tabellenblatt enthält keine Daten!"
      End If
  End With

  strMsg = "Tabellenblatt: " & objWks.Name & vbCr & vbCr & strMsg

'Zählvariablen Case
Dim A As Integer 'L-HU9082
A = 1 'Startwert


For i = 1 To nLastRow - 13

Sheets("Quelldatei").Activate
With ActiveSheet.ListObjects("Tabelle27")
            'ite Zeile auswählen überschrift zählt nicht
                .ListRows(i).Range.Select
            'ite Zeile kopieren
                Selection.Copy
        
'Festlegung der Variablen
    
    Kennzeichen = .Range(i + 1, 8)

End With

Select Case Kennzeichen

             
    Case "B-KR122"
    
       'Tabellenblatt mit entsprechendem Kennzeichen aktivieren
           Sheets(Kennzeichen).Activate
              
       'erste freie Zeile auswählen
           With ActiveSheet.ListObjects("TabelleKR122")
                   .ListRows(A).Range.Select
           End With
               
       'einfügen
               ActiveSheet.Paste
        
        'einfügen einer Zeile 
            Selection.ListObject.ListRows.Add                             hier wird dann die entsprechende Auswahl eingefügt
    
               A = A + 1
   
End Select


Next i

  Set objWks = Nothing
  
End Sub