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

我正在研究将报表中的数据复制到多个工作表的宏。宏工作正常，但我正在努力与一件小事。我想不仅复制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)但它不起作用。在Excel中使用自动筛选器复制和粘贴多个范围

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

来源

2017-08-02 Adrian

这将构建multiarea范围：

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

来源

2017-08-02 10:03:43 avb

谢谢你的答案。宏现在复制正确的列，但N列中的数据被复制到K列，而不是列N（如我所愿）。我在下一行跟着同样的方法，但它不工作'范围（“B2”＆“，”＆“N2”'。 – Adrian

如果你想保留你的选择之间的空白区域，你必须单独复制每个范围，做在目标K，L，M列中有任何数据？如果不是，最简单的方法是复制整个范围（从B到N），然后从K清除到M – avb

列K，L aqnd M包含每次更改月份，我不想“触摸”这些列，我会分别复制每个范围，谢谢你的帮助。 – Adrian

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

回答

相关问题