[英]copy and paste multiple ranges using autofilter in Excel
我正在研究将数据从报表复制到多个工作表的宏。 宏工作正常,但我正在努力解决一件事。 我不仅要复制B9:J范围,还要复制N8:N,但是当我放置("B9:J" & "N9:N" & Lastrow)
宏时("B9:J" & "N9:N" & Lastrow)
所有内容从B列复制到N,但是我想跳过我尝试将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
这将构建多区域范围:
Range("B9:J" & Lastrow & "," & "N9:N" & Lastrow)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.