Question

我想请求您帮我写我想写的宏。我试图在这个网站上寻找解决方案，但我找不到任何东西。

我在Workbook_（当前月份）中有9个不同的工作表 - 例如Workbook_July.xls，我必须从报告中复制9个不同标准的数据（“report_（当前月份）.xls”），每个名称都不同一个月。

工作表名称：“1”，“2”，“3”，“4”，“5”，“6”，“7”，“8”，“9”。（工作簿_（当月））

细胞A8中的自动过滤标准：“EN> 1”，“EN> 2”，“EN> 3”，“EN> 4”，“EN＆gt; 5”，EN＆gt; 6“，EN＆gt; 7”，“EN＆gt; 8”，“EN＆gt; 9”（report_（当前月份）.xls）

我需要做的是过滤报告中的整个表格（A：N列）并从A8中选择标准。然后我需要从A9中选择数据：J9 和 N9直到最后一行。表中的第一行始终相同，但结束行的数量始终不同。我知道我可以使用.End(xlDown)函数，但我不知道如何为A9：J9和N9同时执行此操作。

选择我需要复制的范围后，将标准“EN＆gt; 1”的数据粘贴到工作表“1”，从“EN＆gt; 2”粘贴到工作表“2”，直到最后一个标准“EN＆gt; ; 9“。 Workbook_（当前月份）中工作表的名称始终相同。

我编写了一个在1个工作表上运行良好的宏但我想对所有9个工作表执行此操作（请注意工作簿中有更多工作表）：

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

最重要的一点是我每天更新Workbook_（当前月份），并且需要在包含内容的最后一行之后复制数据，即使它是重复的。因此，如果星期一的最后一行是71，那么在星期二，我需要从72开始将数据从报告复制到工作簿。请注意，我想开始在行A3中复制数据（第1行和第2行包含标题和公式）

提前致谢。

Answer 1

我写了一个非常好用的宏，但是我还在努力解决一件事。在每个月的开始我的跟踪器是空的，当我复制数据的时间我得到运行时错误1004“应用程序定义或对象定义”在行“copyRange.SpecialCells（xlCellTypeVisible）.Copy tgt。范围（ “B3”）。完（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)

是否还有除此copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B3").End(xlDown).Offset(1)之外的其他代码将开始粘贴每个工作簿中单元格B3中复制范围的数据，如果单元格中有任何文本，则转到第一个空单元格并粘贴数据有？

最诚挚的问候，

过滤器，将多个过滤器复制并粘贴到多个工作表

1 个答案: