alxtraxxx schrieb:
Lass das Makro doch nach dem Öffnen einen Autofilter mit den gewünschten Kriterien durchführen und kopieren nur die sichtbaren Zeilen.
Klingt einfach. Kannst du mir den Befehl nennen, mit dem man nur sichtbare Zeilen kopiert?
Dabei könnte aber ein Problem entstehen. Ich hatte nämlich zuerst versucht, die Zieldatei zu filtern. Es sind aber zu viele Möglichkeiten in Spalte C vorhanden. VBA hat dann rumgemeckert, dass es zu viele Einträge seien (alle, die angezeigt werden sollen). Das könnte da natürlich auch entstehen.
Ich hatte auch bereits einen Code, der in der Zieldatei alle Zeilen gelöscht hat, die 1000 und nicht A oder B enthielten. Das hat aber ewig gedauert.
Ok, hier der Code.
Es sollen alle Zeilen der Dateien A1 und B1 in yyy kopiert werden, welche in Spalte C
keine 1000 und in Spalte F ein A oder ein B haben.
Option Explicit
Public sFileA1 As String
Public sFileB1 As String
Sub DateiauswahlA1_Klicken()
sFileA1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
MsgBox (sFileA1)
End Sub
Sub DateiauswahlB1_Klicken()
sFileB1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
MsgBox (sFileB1)
End Sub
Sub DatenEinlesen_Klicken()
Dim NeuerTabellenName As String
' Schaltfläche1_Klicken Makro
' ------------------- A1 ------------------------------
' Zuvor durch den Benutzer ausgewählte Datei öffnen.
Workbooks.Open Filename:=sFileA1
' Selektieren und Kopieren aller Spalten mit Daten
Columns("A:AJ").Select
Selection.Copy
'EINFÜGEN DER QUELLDATEN IN NEUE EXCELDATEI - *A1*
' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
' Erstellen eines neuen Blattes mit variablen Namen durch Benutzer-Eingabe
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
NeuerTabellenName = InputBox("Neuer Name des Blattes")
ActiveSheet.Name = NeuerTabellenName
' Einfügen der Daten
Range("A1").Select
ActiveSheet.Paste
' SCHLIESSEN DER QUELLDATEI
' Automatisches Beantworten der Frage, ob die große Menge in der Zwischenablage behalten werden soll
Application.CutCopyMode = False
' Datei mit Exportdaten wieder aktivieren
Windows("A1.xlsx").Activate
' Frage nach Speicherung der Änderungen mit "nein" beantworten
ActiveWindow.Close savechanges:=False
' ------------------- B1 -------------------------------
' Zuvor durch den Benutzer ausgewählte Datei öffnen.
Workbooks.Open Filename:=sFileB1
' Selektieren und Kopieren aller Spalten mit Daten
Rows("2:5000").Select
Selection.Copy
'EINFÜGEN DER QUELLDATEN IN NEUE EXCELDATEI - *B1*
' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
' Erste leere zeile der Tabelle suchen
Worksheets(NeuerTabellenName).Range("A65536").End(xlUp).Offset(1, 0).Select
' Einfügen der Daten
ActiveSheet.Paste
' SCHLIESSEN DER QUELLDATEI
' Unterdrücken nach der Frage, ob die große Menge in der Zwischenablage behalten werden soll
Application.CutCopyMode = False
' Datei mit Exportdaten wieder aktivieren
Windows("B1.xlsx").Activate
' Frage nach Speicherung der Änderungen mit "nein" beantworten
ActiveWindow.Close savechanges:=False
' ----------------------------------------------------------
' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
End Sub
