Makro aus filter über Vorlage abspeichern

Bild

Betrifft: Makro aus filter über Vorlage abspeichern
von: Michael
Geschrieben am: 27.07.2015 15:34:42

Liebes Forum!
Ich habe ein Probelm mit folgendem Makro:
Option Explicit
'Definition von Makroweit gültigen Variablen
Const SheetUrsprung As String = "Kundeninfo (select)"
Const PfadSpeichern As String = "C:\Users\michael_woditschka\Documents\Makrofile für RUnderwriting"
Const ErsteSpalte As Long = 2 'Liste fängt in Spalte B an (B=1 usw), hier stehen _
die Anwender
Const ErsteZeile As Long = 2 'Einträge ab Zeile 2
Const NameDerTabelle As String = "Table1" 'deine definierte Tabelle heisst "Table1"

Sub FiltereProAnwender()
Dim rGCC_POL_NUMBER As Range
Dim LastRow As Long
Dim wkbNew As Workbook
Dim wkbOld As Workbook
Dim NameOfSave As String
Dim TextPerson As String
'das Workbook merken - denn später geht es in andere Workbooks!
Set wkbOld = ActiveWorkbook
With Sheets(SheetUrsprung)
    'ACHTUNG! Autofilter darf bei Makrostart NICHT gesetzt sein! Reset per Makro
    ResetAutoFilter
    'letzte Zeile
    LastRow = .Cells(.Rows.Count, ErsteSpalte).End(xlUp).Row
    
    'Alle Anwender durchlaufen
    For Each rGCC_POL_NUMBER In .Range(.Cells(ErsteZeile, ErsteSpalte), .Cells(LastRow,  _
ErsteSpalte))
        'Zähle, ob der Anwender das erste mal vorkommt
        If WorksheetFunction.CountIf(.Range(.Cells(ErsteZeile, ErsteSpalte), .Cells( _
rGCC_POL_NUMBER. _
Row, ErsteSpalte)), rGCC_POL_NUMBER) = 1 Then
            'filtere nach Anwender
            .ListObjects(NameDerTabelle).Range.AutoFilter Field:=1, Criteria1:=rGCC_POL_NUMBER.  _
_
Value
            'nur gefilterten Teil der Tabelle kopieren
        End If
        Next rGCC_POL_NUMBER
        Dim wkbVorlage As Workbook
        Set wkbVorlage = Workbooks.Open("C:\Users\michael_woditschka\Documents\Makrofile für  _
RUnderwriting\Kundeninfo Master.xlsm")
        
        With ThisWorkbook.Sheets("Tabelle1")
        
        .Range("B2").Copy wkbVorlage.Sheets("Tabelle1").Range("A2")
        .Range("C2").Copy wkbVorlage.Sheets("Tabelle1").Range("B2")
        .Range("D2").Copy wkbVorlage.Sheets("Tabelle1").Range("C2")
        .Range("E2").Copy wkbVorlage.Sheets("Tabelle1").Range("D2")
        .Range("F2").Copy wkbVorlage.Sheets("Tabelle1").Range("E2")
        .Range("G2").Copy wkbVorlage.Sheets("Tabelle1").Range("F2")
        .Range("H2").Copy wkbVorlage.Sheets("Tabelle1").Range("G2")
        .Range("I2").Copy wkbVorlage.Sheets("Tabelle1").Range("H2")
        .Range("J2").Copy wkbVorlage.Sheets("Tabelle1").Range("I2")
        .Range("K2").Copy wkbVorlage.Sheets("Tabelle1").Range("J2")
        .Range("L2").Copy wkbVorlage.Sheets("Tabelle1").Range("K2")
                 
            .ListObjects(NameDerTabelle).Range.SpecialCells(xlCellTypeVisible).Copy
            'neues Workbook öffnen und merken - neues Workbook ist automatisch im Focus!
            Workbooks.Add
            Set wkbNew = ActiveWorkbook
            'gefilterte Tabelle einfügen und Spaltenbreiten anpassen
            With ActiveSheet
                .Range("A1").PasteSpecial
                .Cells.EntireColumn.AutoFit
            End With
            'neues Workbook speichern (Displayalerts gegen "Datei existiert schon" Dialog)
            NameOfSave = PfadSpeichern & "\" & "Kunde" & rGCC_POL_NUMBER.Value & ".xlsx"
            Application.DisplayAlerts = False
            wkbNew.SaveAs Filename:=NameOfSave, FileFormat:=xlOpenXMLWorkbook, CreateBackup:= _
False
            wkbNew.Close False
            Application.DisplayAlerts = True
            
            wkbOld.Activate 'Zur sicherheit
         
    
   
End With
 ResetAutoFilter
End Sub
Sinn diese Makros sollte folgender werden:
Ich habe eine Basisdatei mit Spalten von A bis Z wobei in B eine Kundennummer steht.
Zuerst sollte durch einen Autofilter in Spalte B nach Nummern gefiltert werden (z.B. 5x Nummer 200) dann diese 5 Zeilen in eine Vorlagendatei kopiert werden und diese wiederum auf einem bestimmten Pfad mit Kundennummer aus Spalte B (in neuen Workbook Spalte A) und Kundenname aus Spalte C (im neuen Workbook Spalte C) gespeichert werden.
Vielen lieben Dank für Eure Hilfe!

Bild

Betrifft: AW: Makro aus filter über Vorlage abspeichern
von: fcs
Geschrieben am: 30.07.2015 04:34:42
Hallo Michael.
leider ist das Makro in der aktuellen Form sehr verwirrend und kann so auch nicht wie ewünscht funktionieren.
Auch deine Beschreibung, was das Makro am Ende können soll ist nicht eindeutig.
Lade doch mal eine ZIP-Datei hoch, die enthält:

  • eine Datei mit dem Tabellenblatt "Kundeninfo (select)" - mit einigen Beispieldatenzeilen mehrerer Kunden, wobei du alle Daten außer der Kunden-Nummer durch anonyme Daten ersetzen kannst, nur die Formate wie Datum, Zahlen etc. sollten erhalten bleiben

  • die Vorlagedatei mit dem Tabellenblatt in das die Daten je Kunde kopiert werden sollen

  • eine Beispiel-Datei für einen Kunden, wie die Vorlagedatei nach dem kopieren der Daten aussehen soll

  • Hier noch ein paar grundsätzliche Fragen.
    1. Datei mit dem Makro
    Wird das Makro in der Datei mit dem Tabellenblatt "Kundeninfo (select)" gespeichert? oder in einer separaten Excel-Datei?
    2. Tabellen/Listen-Bereich
    Stehen die Daten im Blatt "Kundeninfo (select)" wirklich in einem Tabellen/Listen-Bereich ?
    Gemäß der Code-Zeile für das Setzen des Autofilters ja.
    3. ResetAutoFilter
    Diese kleine Zusatzmakro solltest du auch zur Verfügung stellen.
    Gruß
    Franz

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Makro aus filter über Vorlage abspeichern"