Excel VBA copy-paste from source workbook to multiple-sheet workbook

Question

I have a source workbook with one sheet from which, after applying some filters, I copy-paste ranges of data into a new workbook with 2 sheets.

After copy-pasting I shift and remove some columns around in the newly created sheets. The code below works fine until pasting the values selected into the 2nd sheet. However, when I wish to make the modifications to this 2nd sheet, they are done to the first sheet instead which messes up all my data.

After searching for hours I cannot figure out why the second sheet is not addressed properly so I'd be grateful for any help with this issue.

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"))

The changes below happen in Sheet1 instead of Sheet2 where I want then:

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

The code below works and saves the file with the proper sheet names:

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

 End Sub

If you don't specify which workbook or worksheet your Columns statements etc apply to, Excel assumes the ActiveWorkbook and ActiveSheet. ActiveSheet, Activeworkbook, activate and select should generally be avoided in vba as they are slow and prone to changing, which results (as you have seen) in data not going where it should. Fully qualify which workbook and worksheet each statement should be operated against and you'll find it a lot easier to achieve your goal here — Dave
Thank you for your reply. Is it good practice to use the ThisWoorkbook property for all the elements that belong to the worksheet the macro is or should I be fully qualifying everything regardless of whether they are located? — Ioana
ThisWorkbook still only gives you a reference to the file the macro belongs to, I find it often easiest to work at the worksheet level e.g. Dim ws As Worksheet : Set ws = ThisWorkbook.Worksheets("Sheet1") then refer to ws wherever I need to — Dave

Unknown Unknown · Accepted Answer · 2016-06-23T10:12:07

Changes

Reference set to the new worksheet
Code to select and copy combine to single operation
Filter extracted to it's own sub routine

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 copy-paste from source workbook to multiple-sheet workbook

1 Answers