使用Excel中的自动过滤器复制和粘贴多个范围

时间:2017-08-02 09:13:45

标签: excel vba excel-vba

我正在研究将数据从报告复制到多个工作表的宏。宏工作得很好,但我正在努力做一件小事。我不仅要复制B9:J范围而且要复制N8:N但是当我放置("B9:J" & "N9:N" & Lastrow)宏时,将所有内容从B列复制到N但是我想跳过K,L,M列。我试图将Range("B2", "N2")Range("B2" & "N2")放入Copy tgt.Range("B2").End(xlDown).Offset(1),但它不起作用。

Sub report_template()

Const fromFile = "c:\Users\" & Environ("username") & "\Desktop\Report.xls"
Dim srcBook As Workbook
Set srcBook = Application.Workbooks.Open(fromFile, _
UpdateLinks:=False)
Application.ScreenUpdating = False
srcBook.Sheets("Report Page").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "report"
srcBook.Close False

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 > 1"
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B2").End(xlDown).Offset(1)
Set filterRange2 = src.Range("A8:J" & Lastrow)
filterRange2.AutoFilter Field:=1, Criteria1:="EN > 2"
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt2.Range("B2").End(xlDown).Offset(1)
Set filterRange3 = src.Range("A8:J" & Lastrow)
filterRange3.AutoFilter Field:=1, Criteria1:="EN > 3"
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt3.Range("B2").End(xlDown).Offset(1)
Set filterRange4 = src.Range("A8:J" & Lastrow)
filterRange4.AutoFilter Field:=1, Criteria1:="EN > 4"
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt4.Range("B2").End(xlDown).Offset(1)
Application.DisplayAlerts = False
Worksheets("report").Delete
Application.DisplayAlerts = True


Application.ScreenUpdating = False

End Sub

1 个答案:

答案 0 :(得分:0)

这将构建多区域范围:

Range("B9:J" & Lastrow & "," & "N9:N" & Lastrow)