Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.06.2024 10:26:31
25.06.2024 08:19:20
Anzeige
Archiv - Navigation
1352to1356
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

Makro gefilterte Zeilen in neue Mappe kopieren

Makro gefilterte Zeilen in neue Mappe kopieren
02.04.2014 16:31:42
Susann
Hallo Herber-Team,
trotz ausgiebiger Internet-Recherche habe ich das benötigte Makro leider nicht komplett hinbekommen, bitte um Eure Hilfe:
Worum es geht:
habe eine Excel-Arbeitsmappe Name "Gesamtdaten.xlsm", diese soll nach diversen Kriterien gefiltert werden (Makro dafür konnte ich mir mit hilfe des Internets erfolgreich zusammenbauen).
Nun sollen die angezeigten gefilterten Daten (inkl. Überschrift) ganz stupide komplett kopiert werden, jedoch nicht in ein neues Tabellenblatt sondern in eine neue Arbeitsmappe, Name: "gefilterte Daten Göttingen.xls", welche bei diesem Vorgang neu angelegt und nur abgespeichert werden soll.
Der gleiche Vorgang (nur mit anderen Filterkriterien) soll dann mehrmals wiederholt werden und analog wie oben sollen die erneut gefilterten Daten jeweils in einer eigenen neuen Mappe abgespeichert werden.
Mein zusammengebasteltes Makro - was leider nicht funktioniert, sieht so aus ( _
Objektfehlermeldung):

Sub NeuName2()
'Ab Zeile 1 alle gefilterten Zeilen bis Spalte "D" kopieren
' -> gerne auch noch einfacher den kompletten gefilterten Inhalt kopieren lassen, nicht nur bis  _
Spalte D, habe kein besseres Makro gefunden
ActiveSheet.Range("A1:D" & ActiveSheet.UsedRange.Rows.Count).
SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
ActiveWorkbook.SaveAs "D:\Documents and Settings\subing\Desktop\........\April\gefilterte  _
Daten Göttingen.xls"
ActiveWorkbook.Close
Workbooks.Open "D:\Documents and Settings\subing\Desktop\........\April\gefilterte Daten Gö _
ttingen.xls"  'Datei "Datei2.xls" öffnen
Workbooks("gefilterte Daten Göttingen.xls").Sheets("Tabelle1").Range("A2:D").PasteSpecial
'Kopierte Daten einfügen
With Workbooks("gefilterte Daten Göttingen.xls")
.Save
.Close
'Datei "Datei2.xls" speichern und dann schließen
End With
Application.CutCopyMode = True  'Kopierspeicher leeren
Application.ScreenUpdating = True 'Aktualisierungen einschalten
End Sub

Vielen Dank für Eure Unterstützung, Freundliche Grüße Susann

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro gefilterte Zeilen in neue Mappe kopieren
02.04.2014 19:16:24
Spenski
huhu susann
probier das mal . bin zwar blutiger anfänger aber vielleicht klappts ja. wenn nicht lad mal ne datei dazu hoch
Sub Göttingen()
ActiveSheet.Range("$A$1:$D$4").AutoFilter Field:=1, Criteria1:="1"
Cells.Select
Selection.Copy
Workbooks.Open "C:\Users\Spenski\Documents\gefilterte Daten Göttingen.xlsx"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Close True
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$4").AutoFilter Field:=1
End Sub
zeile2 der bereich wo der filter sitzt / welche Spalte du filterst / nach was du filterst
zeile5 der pfad wo die datei gefilterte Datei Göttingen gespeichert ist
zeile11 der bereich wo der filter sitzt / welche Spalte du filterst
mfg
christian

Anzeige
AW: fast fertig! Nur Datumsangabe fehlt noch
03.04.2014 13:05:34
Susann
Hallo und vielen Dank für die Antwort,
auch durch Deine Hilfe konnte ich mir nun das Makro zusammenbasteln und es scheint auch sehr gut zu funktionieren (Makro nachstehend, sorry, dass es so lang ist).
Das einzige was mir hier noch fehlt, ist dass es beim abspeichrn der Datei das aktuelle Datum in den Dateinamen mit einfügt, so dass die Datei dann heißt: Verträge Göttingen_03.04.2014.xlsx (oder so ähnlich):
Workbooks.Add
ActiveWorkbook.SaveAs "D:\Documents and Settings\suf.....\Verträge Göttingen.xlsx"
Und in wieweit muss dann der nachstehende Makro-Part geändert werden, wenn die Datei mit aktuellem Datum versehen wieder geöffnet werden soll?
Workbooks.Open "D:\Documents and Settings\suf.....\Verträge Göttingen.xlsx"
Range("A1").Select
Hier das aktuell funktionierende Makro_nur ohne dass die neuen Mappen mit aktuellem Datum abspeichert:
Sub gefilterte_Daten_in_neue_Mappen_kopieren()
'** Autofilter für Verträge Göttingen mit mehreren Kriterien
'** in Spalte B setzen
'** Dimensionierung der Variablen
Dim rngFilterRange As Range
Dim lngCriteriaCount As Long
Dim arrCriteria() As String
'** Anzahl der Kriterien festlegen
lngCriteriaCount = 3
'** Variable neu dimensionieren
ReDim arrCriteria(0 To lngCriteriaCount - 1)
'** Filterkriterien festlegen
arrCriteria(0) = "195022"
arrCriteria(1) = "2507658"
arrCriteria(2) = "4869444"
'** Objektvariable setzen
Set rngFilterRange = ActiveSheet.Range("A1:GH200000")
'** Autofilter setzen/ausführen
rngFilterRange.AutoFilter Field:=2, _
Criteria1:=arrCriteria(), _
Operator:=xlFilterValues
'** Objektvariable zurücksetzen
Set rngFilterRange = Nothing
Workbooks.Add
ActiveWorkbook.SaveAs "D:\Documents and Settings\suf.....\Verträge Göttingen.xlsx"
ActiveWorkbook.Close
Sheets("Tabelle1").Select
Dim loLetzte As Long
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
Range("A1:GH" & loLetzte).copy
Workbooks.Open "D:\Documents and Settings\suf.....\Verträge Göttingen.xlsx"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Close True
Application.CutCopyMode = False
'** Autofilter zurücksetzen, dieses Makro wurde aufgezeichnet
ActiveSheet.Rows("1:1").Select
Selection.AutoFilter
'** Autofilter für Verträge Einbeck mit mehreren Kriterien
'** in Spalte B setzen
'** Dimensionierung der Variablen
Dim rngFilterRange As Range
Dim lngCriteriaCount As Long
Dim arrCriteria() As String
'** Anzahl der Kriterien festlegen
lngCriteriaCount = 2
'** Variable neu dimensionieren
ReDim arrCriteria(0 To lngCriteriaCount - 1)
'** Filterkriterien festlegen
arrCriteria(0) = "2505648"
arrCriteria(1) = "4865420"
'** Objektvariable setzen
Set rngFilterRange = ActiveSheet.Range("A1:GH200000")
'** Autofilter setzen/ausführen
rngFilterRange.AutoFilter Field:=2, _
Criteria1:=arrCriteria(), _
Operator:=xlFilterValues
'** Objektvariable zurücksetzen
Set rngFilterRange = Nothing
Workbooks.Add
ActiveWorkbook.SaveAs "D:\Documents and Settings\suf.....\Verträge Einbeck.xlsx"
ActiveWorkbook.Close
Sheets("Tabelle1").Select
Dim loLetzte As Long
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
Range("A1:GH" & loLetzte).copy
Workbooks.Open "D:\Documents and Settings\suf.....\Verträge Einbeck.xlsx"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Close True
Application.CutCopyMode = False
'** Autofilter zurücksetzen, dieses Makro wurde aufgezeichnet
ActiveSheet.Rows("1:1").Select
Selection.AutoFilter
'Analog dazu werden dann gleiche bzw. ähnliche makros hier angefügt denn iese Vorgänge  _
wiederholen sich dann immer wieder, bis für alle Suchkriterien alle neue bfüllten Excel-Datein erstellt worden sind
End Sub

Beste Grüße, Susann

Anzeige
AW: fast fertig! Nur Datumsangabe fehlt noch
03.04.2014 13:13:06
Rudi
Hallo,
ActiveWorkbook.SaveAs "D:\Documents and Settings\suf.....\Verträge Göttingen_" & Format(Date,"DD.MM.YYYY") &".xlsx"
Gruß
Rudi

AW: vielen, vielen Dank :-) o.w.T.
04.04.2014 09:45:56
Susann
Vielen, vielen Dank :-) o.w.T.

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige