Excel VBA从源工作簿复制粘贴到多页工作簿

我有一个来源工作簿，其中，在应用一些filter后，我将数据范围复制到2张工作簿中。

复制粘贴后，我移动并删除新创build的工作表中的一些列。 下面的代码工作正常，直到粘贴到第二张select的值。 但是，当我想对第二张纸进行修改时，他们会完成第一张纸，而不是整理所有数据。

search了几个小时后，我无法弄清楚为什么第二张纸不能正确处理，所以我会很感激这个问题的任何帮助。

Sub ActiveHeadcount() Dim ActiveHC As Workbook Dim HCrange As Range Dim ActiveHCrangedest As Range Dim lastrow As Integer Dim getbook As String With ActiveSheet.UsedRange .Value = .Value End With With Sheet1 .Range("A1:AR1").AutoFilter .Range("A1:AR1").AutoFilter Field:=8, Criteria1:="Active" .Range("$A$1:$AR$1").AutoFilter Field:=10, Criteria1:=Array( _ "Apprenticeship", "Fixed term contract", "Permanent",_ "Permanent-Expat","Trainee","="), Operator:=xlFilterValues End With Set ActiveHC = Workbooks.Add Set HCrange = ThisWorkbook.Worksheets_ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy (ActiveHC.Worksheets("Sheet1").Range("A1")) Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("AL:AL").Select Selection.Cut Range("B1").Select ActiveSheet.Paste Columns("C:C").Select Selection.Delete Shift:=xlToLeft Columns("K:K").Select Selection.Delete Shift:=xlToLeft Columns("M:R").Select Selection.Delete Shift:=xlToLeft Columns("Q:Q").Select Selection.Delete Shift:=xlToLeft Columns("Y:AC").Select Selection.Delete Shift:=xlToLeft Columns("AB:AC").Select Selection.Delete Shift:=xlToLeft Sheets("Sheet1").Name = "SAP HC " & Format(Date, "ddmmyy") If ActiveSheet.FilterMode Then Cells.AutoFilter End If With Sheet1 .Range("A1:AR1").AutoFilter .Range("$A$1:$AR$1").AutoFilter Field:=8, Criteria1:=Array( _ "Active", "Inactive"), Operator:=xlFilterValues .Range("$A$1:$AR$1").AutoFilter Field:=10, Criteria1:=Array( _ "Contractor", "Subcontractor"), Operator:=xlFilterValues End With Set HCrange = ThisWorkbook.Worksheets_ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy (ActiveHC.Worksheets("Sheet2").Range("A1")) 

下面的更改发生在Sheet1而不是Sheet2，然后我想要：

 Columns("B:B").Select Selection.Delete Shift:=xlToLeft Columns("AJ:AJ").Select Selection.Cut Columns("B:B").Select Selection.Insert Shift:=xlToRight 

下面的代码工作并保存具有正确的表名称的文件：

  Sheets("Sheet2").Name = "Contractors " & Format(Date, "ddmmyy") ActiveHC.SaveAs Filename:="D:\Macro Finance HC" & "\Global Headcount " _ &Format(Date, "ddmmyy") & ".xlsx" End Sub 

Answer 1

变化

• 引用设置为新的工作表
• 代码select和复制合并为单一操作
• 筛选提取到它自己的子例程

 Sub ActiveHeadcount（）
    昏暗ActiveHC作为工作簿
    昏暗的HCWorksheet作为工作表
    昏暗的HCrange作为范围
     Dim ActiveHCrangedest As Range
     Dim lastrow As Integer
     Dim getbook As String

    与ActiveSheet.UsedRange
         .value = .value
    结束

     FilterSheet1 Array（“Active”，“Inactive”），Array（“Apprenticeship”，“Fixed term contract”，“Permanent”，“Permanent-Expat”，“Trainee”，“=”）

     Application.SheetsInNewWorkbook = 1
    设置ActiveHC = Workbooks.Add
     Application.SheetsInNewWorkbook = 3
    设置HCWorksheet = ActiveHC.Worksheets（1）
    设置HCrange = ThisWorkbook.Worksheets _
                   （ “工作表Sheet”）。Cells.SpecialCells（xlCellTypeVisible）

     HCrange.Copy HCWorksheet.Range（“A1”）

    用HCWorksheet
         .Columns（“B”）。Insert Shift：= xlToRight，CopyOrigin：= xlFormatFromLeftOrAbove
         .Columns（“AL”）。Copy .Columns（“B”）
         .Columns（ “AL”）。删除
         .Columns（“C”）。删除Shift：= xlToLeft
         .Columns（“K”）。删除Shift：= xlToLeft
         .Columns（“M：R”）。删除Shift：= xlToLeft
         .Columns（“Q”）。删除Shift：= xlToLeft
         .Columns（“Y：AC”）。删除Shift：= xlToLeft
         .Columns（“AB：AC”）。删除Shift：= xlToLeft
         .Name =“SAP HC”＆Format（Date，“ddmmyy”）
    结束


    如果ActiveSheet.FilterMode然后
         Cells.AutoFilter
    万一

     FilterSheet1 Array（“Active”，“Inactive”），Array（“Contractor”，“Subcontractor”）

    设置HCrange = ThisWorkbook.Worksheets _
                   （ “工作表Sheet”）。Cells.SpecialCells（xlCellTypeVisible）

     HCrange.Copy（ActiveHC.Worksheets（“Sheet2”）。Range（“A1”））

结束小组

 Sub FilterSheet1（arFilter1，arFilter2）

    用Sheet1
         .Range。（ “A1：AR1”）自动筛选
         .Range（“$ A $ 1：$ AR $ 1”）。AutoFilter Field：= 8，Criteria1：= Array（_
                                                              “有效”，“无效”），运算符：= xlFilterValues
         .Range（“$ A $ 1：$ AR $ 1”）。AutoFilter字段：= 10，Criteria1：= arFilter2，运算符：= xlFilterValues
    结束
结束小组