繁体   English   中英

在Excel中使用自动筛选功能复制和粘贴多个范围

[英]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.

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