Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1432to1436
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Spalten komplett kopieren bei aktivem Filter

VBA: Spalten komplett kopieren bei aktivem Filter
20.06.2015 10:28:21
ice987
Guten Morgen,
Ich möchte drei komplette Spalten aus der Tabelle1 (Original) in die Tabelle2 (Kopie) mittels VBA kopieren. In der Tabelle1 ist ein Filter gesetzt, in die Tabelle2 sollen jedoch alle (auch die nicht sichtbaren Zellen aus Tabelle1) kopiert werden. Unglücklicherweise kopiert er in meinen Versuchen (mittels Loop, auskommentiert, bzw. direkt kopiert) nur die sichtbaren Zellen. Kann mir evtl. jemand weiterhelfen?
https://www.herber.de/bbs/user/98324.xlsm
Vielen Dank bereits im Voraus,
Grüsse

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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

Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige