Option Explicit

Sub Mein_Übertrag_Montagefirma()
Dim rngU As Range       'tatsächlich genutzter Bereich
Dim rngB As Range       'iteriere durch Spalte B
Dim rngT As Range       'zu kopierender Bereich
Dim loAnz As Long       'Zählen
Dim loLetzte As Long    'letzte befüllte Zeile

   'wer ausschaltet sollte auch wieder einschalten
   Application.ScreenUpdating = False
    
   With Worksheets("Montagefirma")
      .Range("A1:AA" & .Cells(.Rows.Count, 1).End(xlUp).Row).Clear
    End With

   With Worksheets("Terminplan")
      .Columns("A:B").Hidden = False
      'tatsächlich genutzter Bereich
      Set rngU = Range(.Cells(1), .Cells(.Cells.Find("*", _
         .Cells(1), -4123, 2, 1, 2, False).Row, _
         .Cells.Find("*", .Cells(1), -4123, 2, 2, 2, False).Column))
      For Each rngB In rngU.Columns("B").Cells
         'Abgleich
         If rngB.Text = .Range("F6").Text Then
            'Zählen
            loAnz = loAnz + 1
            'zu kopierender Bereich
            Set rngT = rngU.Rows(rngB.Row)
            Set rngT = rngT.Offset(, 2).Resize(, rngT.Columns.Count - 2)
            rngT.Copy
            With Worksheets("Montagefirma")
               If .Cells(1) = "" Then
                  loLetzte = 1
               Else
                  loLetzte = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row + 1
               End If
              .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
              .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteFormats
            End With
         End If
      Next rngB
         
      Application.CutCopyMode = False
      .Columns("A:B").Hidden = True
         
   End With
   
   MsgBox "Es wurden " & loAnz & " Sätze übertragen."
   Application.ScreenUpdating = True

End Sub