CODEWITHSUNDEEP
excelvba
Ioana
Ioana

Reputation: 37

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

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

Upvotes: 3

Views: 1167

Answers (1)

user6432984
user6432984

Reputation:

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

Upvotes: 1

Related Questions