gefilterte Daten in neues Workbook übertragen

[lapunta]

Hi, alle miteinander

...hänge mal wieder an einer Kleinigkeit fest.

folgendes Problem: Makro soll Autofilter setzen und die ausgefilterten Datensätze (Spalten A bis D) als Werte in eine neue Arbeitsmappe (Tabelle1) übertragen - bislang bin ich lediglich soweit, daß es mir die Daten in die gleiche Arbeitsmappe (Tabelle1) schreibt - das mit der Neuen  will einfach nicht klappen.

Code:

Sub Makro1()
Dim i As Long
Dim Tabelle1 As Worksheet
Dim pfad As String

If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

'Daten mit Autofilter filtern
  Range("F6").Select
   Selection.AutoFilter
   Selection.AutoFilter Field:=6, Criteria1:="MF"
   
'gefilterte Daten kopieren
   With ActiveSheet.AutoFilter.Range.Offset(1)
       .Cells(7, 4).Resize(.Rows.Count).Offset(, -3). _
        Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
   End With
   
'Autofilter zurücksetzen
   With Worksheets("Cosmos")
       If .FilterMode Then
           .ShowAllData
           Selection.AutoFilter
       End If
   End With
   
'gefilterte Daten einfügen
   pfad = "C:\Users\Frank\Documents\Aktien\Mai16\KurseAbfragen.xlsm"
   Workbooks.Open pfad

   ActiveWorksheet = "Tabelle1"
   Range("A7").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   ActiveWorkbook.Close False
   Application.CutCopyMode = False
   
Call Format
Range("A7").Select
   
End Sub

[Gast 123]

Hallo,

ich habe einen -ungetesteten- Lösungsvorschlag, und hoffe es funktioniert damit.

Meine Vermutung ist, das nach dem Copy folgende Befehle, Filter deaktivieren, Datei Öffnen,
 evtl. den Copy Befehl löschen könnten. Dann ist es m.E. sinnvoll die Datei vorher zu öffnen.
Bitte einfach mal ausprobieren ob es so funktioniert. Ohne Garantie, nicht getestet.

mfgh  Gast 123


'Lösungsvorschlag von Gast 123  3.6.2016   (nicht getestet)

Code:

Sub Makro1()
Dim i As Long
Dim Tabelle1 As Worksheet
Dim pfad As String

Dim ThisWb As String    'This Workbook
Dim OpenWb As String    'Open Workbook
ThisWb = ThisWorkbook.Name  'Name merken

If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

   'Pfad zuerst Öffnen und Open Wb-Namen in Variable laden
   pfad = "C:\Users\Frank\Documents\Aktien\Mai16\KurseAbfragen.xlsm"
   Workbooks.Open pfad
   OpenWb = ActiveWorkbook.Name

   'Fenster zurücksetzen auf Aktive Mappe
   Windows(ThisWb).Activate

'Daten mit Autofilter filtern
  Range("F6").Select
   Selection.AutoFilter
   Selection.AutoFilter Field:=6, Criteria1:="MF"
   
'gefilterte Daten kopieren
   With ActiveSheet.AutoFilter.Range.Offset(1)
       .Cells(7, 4).Resize(.Rows.Count).Offset(, -3). _
        Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
   End With
   
'gefilterte Daten einfügen
   With Workbooks(OpenWb).Worksheets("Tabelle1")
      .Range("A7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
   End With
   Application.CutCopyMode = False
   
'Autofilter zurücksetzen
   With Worksheets("Cosmos")
       If .FilterMode Then
           .ShowAllData
           Selection.AutoFilter
       End If
   End With
   
   Workbooks(OpenWb).Close False
   
Call Format
Range("A7").Select
   
End Sub

[schauan]

Hallöchen,

ja, das kann ich bestätigen. Eine neue Datei erstellen oder eine öffnen beendet den "excelinternen" Kopiervorgang. Es gibt lediglich wenige Ausnahmen, z.B. manuell aus der Eingabezeile kopierte Daten.