AW: Nur sichtbare Zeilen kopieren und einfügen
23.09.2013 13:44:01
fcs
Hallo Tim,
hier ein entsprechendes Makro.
Das Makro kannst du dann einer Schaltfläche aus den Formularsteuerelmenten zuordnen.
Das Makro erzeugt auch das neue Tabellenblatt, in das die Daten aus dem aktuellen Blatt kopiert werden sollen. Wenn man das Zielblatt (bei dir z.Zt. Tabelle17) immer eindeutig identifizieren Kann (Blattname Indexnummer, 1. oder letztes Tabellenblatt) dann kann man als Zieltabelle auch eine vorhandene Tabelle setzen.
Gruß
Franz
Sub Copy_A_D()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngZeile As Long, lngZeile_Z As Long
Set wksQ = ActiveSheet
'neues tabellenblatt anlegen als Zieltabelle
Set wksZ = ActiveWorkbook.Worksheets.Add(After:=wksQ) '
lngZeile_Z = 1 'Startzeile für das Einfügen ggf. anpassen
Application.ScreenUpdating = False
With wksQ
If Val(Left(Application.Version, 2)) >= 12 Then
.Range(.Columns(1), .Columns(4)).Copy 'Spaltenbreiten kopieren
End If
wksZ.Cells(1, 1).PasteSpecial Paste:=8 'xlPasteColumnWidths
Range("A1").Select
With .Range(.Cells(12, 1), .Cells(.Rows.Count, 4))
lngZeile = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
End With
For lngZeile = 12 To lngZeile
If .Rows(lngZeile).Hidden = False Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 4)).Copy _
Destination:=wksZ.Cells(lngZeile_Z, 1)
lngZeile_Z = lngZeile_Z + 1
End If
Next
End With
Application.ScreenUpdating = True
End Sub