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

更改

参考设置为新工作表
选择和复制合并为单一操作的代码
过滤器提取到自己的子程序

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

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

1 个答案: