filter, kopiere und füge mehrere Filter in mehrere Arbeitsblätter ein

Question

Ich möchte dich um Hilfe mit meinem Makro bitten, dass ich schreiben möchte. Ich habe versucht, auf dieser Website nach Lösungen zu suchen, konnte aber nichts finden.

Ich habe 9 verschiedene Arbeitsblätter in Workbook_ (aktueller Monat) - zum Beispiel Workbook_July.xls, wo ich Daten mit 9 verschiedenen Kriterien aus dem Bericht kopieren muss ("report_ (aktueller Monat) .xls"), der Name ist anders jeden Monat.

Arbeitsblattnamen: "1", "2", "3", "4", "5", "6", "7", "8", "9". (Arbeitsbuch_ (aktueller Monat))

Autofilter-Kriterien in Zelle A8: "EN> 1", "EN> 2", "EN> 3", "EN> 4", "EN> 5", EN> 6 ", EN> 7", "EN> 8", "EN> 9" (Bericht_ (aktueller Monat) .xls)

Was ich tun muss, ist die gesamte Tabelle im Bericht zu filtern (Spalten A: N) und wählen Sie Kriterien aus A8. Dann muss ich Daten von A9: J9 und N9 bis zur letzten Zeile auswählen. Die erste Zeile in der Tabelle ist immer die gleiche, aber die Anzahl der Endzeilen ist immer unterschiedlich. Ich weiß, was ich .End(xlDown) Funktion verwenden kann, aber ich weiß nicht, wie dies für A9 simultan zu tun: J9 und N9.

Nachdem ich den zu kopierenden Bereich ausgewählt habe, fügen Sie die Daten von Kriterium "EN> 1" in Arbeitsblatt "1", von "EN> 2" in Arbeitsblatt "2" bis zum letzten Kriterium "EN> 9 ". Der Name der Arbeitsblätter in Workbook_ (aktueller Monat) ist immer gleich.

Ich schrieb ein Makro, das ziemlich gut auf 1 Arbeitsblatt funktioniert, aber ich möchte dies für alle 9 Arbeitsblätter tun (bitte beachten Sie, dass es mehrere Arbeitsblätter in der Arbeitsmappe sind):

Sub copyandpaste1() 

Application.ScreenUpdating = False 

ActiveWorkbook.Sheets("1").Activate 

yourPath = "C:\Users\" & Environ("username") & "\Desktop\test\VTR tracker\" 
file = Dir(yourPath & "Report*.xls") 
Do While file <> vbNullString 
Workbooks.Open (yourPath & file) 
file = Dir() 
Loop 

Rows("8:8").Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$8:$N$50000").AutoFilter Field:=1, Criteria1:= _ 
    "EN > 1" 

With Worksheets("Report*").AutoFilter.Range 
Range("B" & .Offset(2, 9).SpecialCells(xlCellTypeVisible)(9).Row).Select 
End With 

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 8)).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 

For Each wb In Application.Workbooks 
If wb.Name Like "Workbook*" Then 
    wb.Activate 
End If 
Next wb 
Worksheets("1").Activate 
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row 
Range("B" & lMaxRows + 1).Select 
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 8)).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 

For Each wb In Application.Workbooks 
If wb.Name Like "Workbook*" Then 
    wb.Activate 
End If 
Next wb 
Worksheets("1").Activate 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
Range("A4").Select 
Application.CutCopyMode = False 

Application.ScreenUpdating = False 

For Each w In Workbooks 
If w.Name Like "*Report*" Then 
Windows(w.Name).Activate 
Exit For 
End If 
Next w 

With Worksheets("Report").AutoFilter.Range 
Range("B" & .Offset(14, 9).SpecialCells(xlCellTypeVisible)(9).Row).Select 
End With 

Range(ActiveCell.Offset(0, 12), ActiveCell.Offset(0, 12)).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 

For Each wb In Application.Workbooks 
If wb.Name Like "Viator_Translation_Tracker_*" Then 
    wb.Activate 
End If 
Next wb 
Worksheets("1").Activate 
lMaxRows = Cells(Rows.Count, "N").End(xlUp).Row 
Range("N" & lMaxRows + 1).Select 
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 

End Sub 

Einer der wichtigsten Ich aktualisiere Workbook_ (aktueller Monat) jeden Tag und die Daten müssen nach der letzten Zeile mit Inhalt kopiert werden, auch wenn es sich um ein Duplikat handelt. Wenn also die letzte Zeile am Montag 71 ist, dann am Dienstag, muss ich die Daten vom Bericht in Workbook von 72 kopieren. Bitte beachten Sie, dass ich Daten in Zeile A3 kopieren möchte (Zeilen 1 und 2 enthält Kopfzeilen und Formeln)

Vielen Dank im Voraus.

Answer 1

Ich schrieb ein Makro, das ziemlich gut funktioniert, aber ich kämpfe immer noch mit 1 Sache. Zu Beginn jedes Monats ist mein Tracker leer und wenn ich die Daten für die Zeit kopiere, erhalte ich einen Laufzeitfehler 1004 "Anwendungsdefiniert oder Objektdefiniert" in Zeile "copyRange.SpecialCells (xlCellTypeVisible) .Copy tgt. Range ("B3"). End (xlDown) .Offset (1)“

Dim src As Worksheet 
Dim tgt As Worksheet 
Dim filterRange As Range 
Dim filterRange2 As Range 
Dim filterRange3 As Range 
Dim filterRange4 As Range 
Dim copyRange As Range 
Dim lastRow As Long 
Dim tgt2 As Worksheet 
Set src = ThisWorkbook.Sheets("report") 
Set tgt = ThisWorkbook.Sheets("1") 
Set tgt2 = ThisWorkbook.Sheets("2") 
Set tgt3 = ThisWorkbook.Sheets("3") 
Set tgt4 = ThisWorkbook.Sheets("4") 
src.AutoFilterMode = False 
lastRow = src.Range("B" & src.Rows.Count).End(xlUp).Row 
Set filterRange = src.Range("A8:J" & lastRow) 
Set copyRange = src.Range("B9:J" & lastRow) 
filterRange.AutoFilter Field:=1, Criteria1:="EN-GB > 1" 
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B3").End(xlDown).Offset(1) 
Set filterRange2 = src.Range("A8:J" & lastRow) 
filterRange2.AutoFilter Field:=1, Criteria1:="EN-GB > 2" 
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt2.Range("B3").End(xlDown).Offset(1) 
Set filterRange3 = src.Range("A8:J" & lastRow) 
filterRange3.AutoFilter Field:=1, Criteria1:="EN-GB > 3" 
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt3.Range("B3").End(xlDown).Offset(1) 
Set filterRange4 = src.Range("A8:J" & lastRow) 
filterRange4.AutoFilter Field:=1, Criteria1:="EN-GB > 4" 
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt4.Range("B3").End(xlDown).Offset(1) 

gibt es einen anderen Code als diese copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B3").End(xlDown).Offset(1), die die Daten von Kopierbereich in Zelle B3 in jedem Arbeitsmappe einfügen wird gestartet, und wenn es ist irgendein Text in der Zelle, gehe dann zur ersten leeren Zelle und füge dort die Daten ein?

Mit freundlichen Grüßen,