Makro nur sichtbare Zellen kopieren und übertragen
07.06.2019 09:16:53
Matthias
ich habe folgenden Makro, dieses überträgt bestimmte Zeilen
von einem Blatt in ein anderes.
Nun würde ich dieses gerne erweitern, dass es nur die Sichtbaren Zeilen und Spalten überträgt. Ich bekomme dies einfach nicht hin und wäre für Hilfe dankbar.
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 letzte As Long
' ermittelt die letzte befüllte Zelle
Worksheets("Montagefirma").Activate
letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
' ermittelt die letzte befüllte Zelle
' Markiert und löscht den Bereich
Worksheets("Montagefirma").Range("A1:AA" & letzte).Clear
Worksheets("Montagefirma").Range("A1").Activate
Sheets(Blatt1).Activate
Range("C1").Select
iAnz = 0
I = 0
Do Until I = ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Text = Range("F" & 6).Text Then
Selection.EntireRow.Copy
Sheets(Blatt2).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Sheets(Blatt1).Select
ActiveCell.Offset(1, 0).Select
iAnz = iAnz + 1
Else
ActiveCell.Offset(1, 0).Select
End If
I = I + 1
Loop
MsgBox "Es wurden " & iAnz & " Sätze übertragen"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub