Re: ausgelendete Spalten bei Filter mit kopieren
06.06.2003 14:22:35
Bengsch, Frank
Hallo,
ich habe den Copy Befehl probiert - hat aber trotzdem nicht geklappt. Habe mir jetzt eine andere Lösung überlegt:
Ich kopiere die ganze Tabelle ohne Überschriften und Filter in die Ziel Tabelle. Dann setze ich einen Filter der nicht ausgewählten Kreterien und entferne diese Zeilen. Im Anschluß werden im Filter wieder alle Zeilen des Zieles angezeigt.
Code nachfolgend :
Private Sub cmd_EMail_Click()Dim c_quelle As String
Dim c_ziel As String
Dim letzte As Long
Dim wkb_quelle As Workbook
Dim wkb_ziel As Workbook
' Application.ScreenUpdating = False
'wbk_quelle.Activate
Set wkb_quelle = ActiveWorkbook
' Ziel vorbereiten
Application.StatusBar = "Mail Tabelle wird geöffnet"
Workbooks.Open FileName:="c:\Renner-Penner EMail.xls"
Set wkb_ziel = ActiveWorkbook
' alten Inhalt in Zieldatei löschen
Application.StatusBar = "Mail Tabelle wird bearbeitet"
Range("AP9").Select
letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If letzte < 9 Then ' falls keine Zeilen ab AP9 vorhanden und der Wert kleiner ist
letzte = 9
End If
Range("AP9:AP" & letzte).Select
Selection.EntireRow.Delete
' Quelle vorbereiten
wkb_quelle.Activate
letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Range("A9:CF" & letzte).Select
Selection.Copy
' auf Ziel zum einfügen wechseln
wkb_ziel.Activate
Range("A9").Select
ActiveSheet.Paste ' Destination:=Range("AP9")
Application.StatusBar = "Mail Tabelle Filter setzen"
Selection.AutoFilter field:=42, Criteria1:=("<>" & pbl_lst_wert), Operator:=xlAnd
Application.StatusBar = "Mail Tabelle Zeile aus Filter löschen"
Selection.EntireRow.Delete
Application.StatusBar = "Mail Tabelle Filter wieder deaktivieren"
Selection.AutoFilter field:=42
Range("ap9").Select
Application.StatusBar = "Mail Tabelle wird geschlossen/gesichert"
wkb_ziel.Close savechanges:=True
wkb_quelle.Activate
Application.CutCopyMode = False
Range("ap9").Select
Application.StatusBar = False
Application.DisplayStatusBar = pbl_Statuszeile
End Sub