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

Question

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

3

我有一个源工作簿，其中有一个工作表，经过一些筛选后，我将数据范围复制粘贴到一个具有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

- Ioana

1

如果您没有指定Columns语句等应用于哪个工作簿或工作表，Excel会默认为ActiveWorkbook和ActiveSheet。在vba中，应该尽量避免使用ActiveSheet、Activeworkbook、activate和select，因为它们速度较慢且容易发生变化，这会导致数据不在应该在的位置。完全限定每个语句应操作的工作簿和工作表，您将发现在此实现目标会更加容易。 - Dave

谢谢您的回复。在宏所属的工作表中，对于所有元素是否使用ThisWorkbook属性是一个好的实践，还是应该完全限定无论它们的位置在哪里？ - Ioana

ThisWorkbook仅提供宏所属文件的引用，我发现在工作表级别上工作通常是最容易的，例如 Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1") 然后在需要时引用 ws。 - Dave

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- user6432984 · Accepted Answer

变更

引用设置为新工作表
选择和复制组合的代码转换为单个操作
过滤器提取到自己的子程序中

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

'清除当前Sheet的格式 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