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

Question

我有一个带有一张工作表的源工作簿，在应用一些过滤器后，我将数据范围复制粘贴到一个有 2 张工作表的新工作簿中。

复制粘贴后，我在新创建的工作表中移动并删除了一些列。下面的代码可以正常工作，直到将选定的值粘贴到第二张表中。但是，当我希望对第二张表进行修改时，它们是在第一张表上完成的，这会弄乱我的所有数据。

搜索了几个小时后，我无法弄清楚为什么第二张工作表没有正确处理，因此我将不胜感激有关此问题的任何帮助。

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

变化

• 对新工作表的引用集
• 用于选择和复制组合到单个操作的代码
• 过滤器提取到它自己的子程序

子 ActiveHeadcount() 将 ActiveHC 调暗为工作簿 将 HCWorksheet 调暗为工作表 将 HCrange 调暗为范围 调暗 ActiveHCrangedest 作为范围 将 lastrow 调暗为整数 将 getbook 变暗为字符串 使用 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 _ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy HCWorksheet.Range("A1") 使用 HCWorksheet .Columns("B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove .Columns("AL").Copy .Columns("B") .Columns("AL").Delete .Columns("C").Delete Shift:=xlToLeft .Columns("K").Delete Shift:=xlToLeft .Columns("M:R").Delete Shift:=xlToLeft .Columns("Q").Delete Shift:=xlToLeft .Columns("Y:AC").Delete Shift:=xlToLeft .Columns("AB:AC").Delete Shift:=xlToLeft .Name = “SAP HC” & 格式（日期，“ddmmyy”） 结束于 如果 ActiveSheet.FilterMode 则 Cells.AutoFilter 万一 FilterSheet1 Array("Active", "Inactive"), Array("Contractor", "Subcontractor") 设置 HCrange = ThisWorkbook.Worksheets _ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy (ActiveHC.Worksheets("Sheet2").Range("A1")) 结束子 子 FilterSheet1(arFilter1, arFilter2) 使用 Sheet1 .Range("A1:AR1").AutoFilter .Range("$A$1:$AR$1").AutoFilter Field:=8, Criteria1:=Array(_ “活动”，“非活动”），运算符：=xlFilterValues .Range("$A$1:$AR$1").AutoFilter Field:=10, Criteria1:=arFilter2, Operator:=xlFilterValues 结束于 结束子