Hallo Torsten
14.06.2019 10:54:57
Matthias
leider funktioniert das Makro nicht,
es wird nur ein Zeile übertragen.
Kannst du mir da nochmal helfen
danke.
Gruss Matthias
Sub Übertrag_Montagefirma()
Application.ScreenUpdating = False
' Tabelle: Terminplan
' Tabelle: Montagefirma
Const Blatt1 = "Terminplan" ' Source
Const Blatt2 = "Montagefirma" ' Ziel
Dim I As Integer
Dim iAnz As Integer
Dim letzte1 As Long, letzte2 As Long, letzteS As Long
' ermittelt die letzte befüllte Zeile
letzte1 = Sheets(Blatt1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
letzte2 = Sheets(Blatt2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
' ermittelt die letzte befüllte Spalte
letzteS = Sheets(Blatt1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
' löscht den Bereich
Sheets(Blatt2).Range("A1:AA" & letzte2).Clear
With Sheets(Blatt1)
If .Cells(1, 1).Text = .Range("F6").Text Then
.Range(.Cells(1, 2), .Cells(letzte1, letzteS)).SpecialCells(xlCellTypeVisible).Copy
Sheets(Blatt2).Cells(1, 1).PasteSpecial xlPasteValues
End If
End With
letzte2 = Sheets(Blatt2).Cells(Rows.Count, 1).End(xlUp).Row
iAnz = letzte2
MsgBox "Es wurden " & iAnz & " Sätze übertragen"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Anzeige