AW: VBA: Spalten komplett kopieren bei aktivem Filter
20.06.2015 11:56:21
fcs
Hallo ice,
die Loop-Variante funktioniert, die Letzte Zeile im Quellblatt muss jedoch anders ermittelt werden.
Gruß
Franz
Sub Makro1()
'definition der Variablen
Dim Quellentabelle1 As Worksheet
Dim Zieltabelle1 As Worksheet
Dim LetzteZeile As Long
Dim i As Long
'Definition der Tabellennamen
Set Quellentabelle1 = ActiveWorkbook.Worksheets("Tabelle1")
Set Zieltabelle1 = ActiveWorkbook.Worksheets("Tabelle2")
With Application
.ScreenUpdating = False
End With
'Zelleninhalt loeschen
With Zieltabelle1
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If LetzteZeile >= 4 Then
.Range(.Cells(4, 1), .Cells(LetzteZeile, 3)).ClearContents
End If
End With
'letzte gefuellte Zeile suchen und Wert ermitteln
With Quellentabelle1
LetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
If .FilterMode = True Then
With .AutoFilter.Range
LetzteZeile = .Row + .Rows.Count - 1
End With
Else
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End If
'ermittelter Wert ausgeben
Zieltabelle1.Range("A2").Value = LetzteZeile
'Zellen mittels Loop kopieren (funktioniert bei aktivem Filter nicht)
For i = 4 To LetzteZeile
Zieltabelle1.Cells(i, 1).Value = .Cells(i, 1).Value
Zieltabelle1.Cells(i, 2).Value = .Cells(i, 2).Value
Zieltabelle1.Cells(i, 3).Value = .Cells(i, 3).Value
Next i
End With
With Application
.ScreenUpdating = True
End With
End Sub