简体   繁体   中英

copy and paste multiple ranges using autofilter in Excel

I am working on macro that will copy the data from report to multiple worksheets. The macro works fine but I am struggling with one little thing. I would like to copy not only B9:J range but also N8:N however when I put ("B9:J" & "N9:N" & Lastrow) the macro copies everything from column B to N but I would like to skip columns K, L, M. I tried to put Range("B2", "N2") and Range("B2" & "N2") in Copy tgt.Range("B2").End(xlDown).Offset(1) but it doesn't work.

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

这将构建多区域范围:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM