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

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

excel vba

Excel VBA从源工作簿复制粘贴到多页工作簿,excel,vba,Excel,Vba,我有一个带有一张工作表的源工作簿，在应用了一些过滤器后，我将数据的粘贴范围复制到带有两张工作表的新工作簿中复制粘贴后，我移动并删除新创建图纸中的一些列。在将选定的值粘贴到第二页之前，下面的代码可以正常工作。然而，当我想修改这第二页时，它们会改为修改第一页，这会弄乱我所有的数据在搜索了几个小时后，我不明白为什么第二张纸没有正确的地址，所以我非常感谢在这个问题上的任何帮助 Sub ActiveHeadcount() Dim ActiveHC As Workbook Dim HCrange As

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

复制粘贴后，我移动并删除新创建图纸中的一些列。在将选定的值粘贴到第二页之前，下面的代码可以正常工作。然而，当我想修改这第二页时，它们会改为修改第一页，这会弄乱我所有的数据

在搜索了几个小时后，我不明白为什么第二张纸没有正确的地址，所以我非常感谢在这个问题上的任何帮助

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

变化

新工作表的引用集
用于选择并将联合收割机复制到单个操作的代码
过滤器被提取到它自己的子例程中

副总人数（）将ActiveHC设置为工作簿将工作表设置为工作表变暗HCrange As Range Dim ACTIVEHCRANGEST DEST As范围将最后一行设置为整数将getbook设置为字符串使用ActiveSheet.UsedRange .value=.value 以 FilterSheet1数组（“活动”、“非活动”）、数组（“学徒”、“定期合同”、“永久”、“永久外籍人员”、“实习生”、“实习人员”） Application.wWorkbook=1 Set ActiveHC=工作簿。添加 Application.wWorkbook=3 设置HCWorksheet=ActiveHC.工作表（1）设置HCrange=ThisWorkbook.Worksheets_ （“Sheet1”）.单元格.特殊单元格（xlCellTypeVisible） HCrange.Copy HCWorksheet.Range（“A1”）使用HCS工作表 .列（“B”）。插入Shift:=xlToRight，CopyOrigin:=XLFormatFromLeftOrove .列（“AL”）.复制.列（“B”） .列（“AL”）。删除 .列（“C”）。删除移位：=xlToLeft .列（“K”）。删除移位：=xlToLeft .列（“M:R”）。删除移位：=xlToLeft .列（“Q”）。删除移位：=xlToLeft .列（“Y:AC”）。删除移位：=xlToLeft .列（“AB:AC”）。删除移位：=xlToLeft .Name=“SAP HC”和格式（日期，“ddmmyy”）以如果是ActiveSheet.FilterMode，则自动过滤器如果结束过滤器SEET1阵列（“活动”、“非活动”）、阵列（“承包商”、“分包商”）设置HCrange=ThisWorkbook.Worksheets_ （“Sheet1”）.单元格.特殊单元格（xlCellTypeVisible） HCrange.Copy（ActiveHC.Worksheets（“Sheet2”）.Range（“A1”））端接头子过滤器SEET1（arFilter1、arFilter2）附页1 .范围（“A1:AR1”）.自动筛选 .Range（“$A$1:$AR$1”）。自动筛选字段：=8，标准1:=数组（_ “活动”、“非活动”），运算符：=xlFilterValues .Range（“$A$1:$AR$1”）。自动筛选字段：=10，准则1:=arFilter2，运算符：=xlFilterValues 以端接头

如果未指定

列

语句等应用于哪个工作簿或工作表，Excel将假定

Active工作簿

和

ActiveSheet

<在vba中，通常应避免使用代码>活动工作表、

活动工作簿

、

激活

和

选择

，因为它们速度慢且易于更改，这会导致（正如您所看到的）数据无法正常运行。完全限定每个陈述应该针对哪个工作簿和工作表进行操作，您会发现实现您的目标要容易得多。谢谢您的回复。对属于宏所在工作表的所有元素使用ThisWoorkbook属性是一种良好做法，还是应该完全限定所有元素，而不管它们是否位于工作表中？

ThisWorkbook

仍然只提供宏所属文件的引用，我发现在工作表级别工作通常是最容易的，例如

Dim ws As worksheet:Set ws=thiswoolk.Worksheets（“Sheet1”）

然后在我需要的任何地方参考

ws

，不要介意我以前的评论。现在这个效果很好。 Sub ActiveHeadcount() Dim ActiveHC As Workbook Dim HCWorksheet As Worksheet Dim HCrange As Range Dim ActiveHCrangedest As Range Dim lastrow As Integer Dim getbook As String With ActiveSheet.UsedRange .value = .value End With FilterSheet1 Array("Active", "Inactive"), Array("Apprenticeship", "Fixed term contract", "Permanent", "Permanent-Expat", "Trainee", "=") Application.SheetsInNewWorkbook = 1 Set ActiveHC = Workbooks.Add Application.SheetsInNewWorkbook = 3 Set HCWorksheet = ActiveHC.Worksheets(1) Set HCrange = ThisWorkbook.Worksheets _ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy HCWorksheet.Range("A1") With 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 " & Format(Date, "ddmmyy") End With If ActiveSheet.FilterMode Then Cells.AutoFilter End If FilterSheet1 Array("Active", "Inactive"), Array("Contractor", "Subcontractor") Set HCrange = ThisWorkbook.Worksheets _ ("Sheet1").Cells.SpecialCells(xlCellTypeVisible) HCrange.Copy (ActiveHC.Worksheets("Sheet2").Range("A1")) End Sub Sub FilterSheet1(arFilter1, arFilter2) 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:=arFilter2, Operator:=xlFilterValues End With End Sub