Copying multiple sheets into a new workbook (for distribution)
Question
Editting the post for a new code which is giving an "Invalid Qualifier" Error
I am having trouble editing this vba code after recording a macro. The macro code is as per below.
I am now getting an "object not defined" error at this line"Dim SpendReport As Workbook Set SpendReport = ActiveWorkbook.Sheets(1).Range("A1").Value Workbooks.Add"
Highly suspecting is my variable definition thats wrong ?
The idea here is to duplicate these 4 sheets into a whole new workbook and then pasting them as values prior to saving.
Would an expert here be able to help with the editting of the code to make this more flexible?
Thank you!
New editted code with object error:
Sub Data_Cleanser()
'
'
'
Application.ScreenUpdating = False
Dim wsRaw As Worksheet
Set wsRaw = Sheets("RAW DATA")
Dim wsPivot As Worksheet
Set wsPivot = Sheets("Pivot_RAW_DATA")
Dim wsPivotM As Worksheet
Set wsPivotM = Sheets("Pivot")
Dim lastRowRD As Long
lastRowRD = wsRaw.Cells(Rows.Count, "A").End(xlUp).Row
Dim wbS As Workbook
Set wbS = Workbooks("Spend automator.xlsm")
Dim wsSplitBU As Worksheet
Set wsSplitBU = Sheets("Split BU (HUTAS)")
Dim wsLocalS As Worksheet
Set wsLocalS = Sheets("Localization Spend")
Dim wsPlantSp As Worksheet
Set wsPlantSp = Sheets("Bedok, Changi, Bandung Spend")
''''''''''''''''''''''''''''''
'Populate formula'
''''''''''''''''''''''''''''''
[Aa1].Resize(lastRowRD - 1, 1).FormulaR1C1 = ("BU Correction Generator")
[Aa2].Resize(lastRowRD - 1, 1).Formula = ("=VLOOKUP(N2,'BU CORRECTOR REFERENCE'!$A:$C,3,FALSE)")
''''''''''''''''''''''''''''''
'Refresh Pivot'
''''''''''''''''''''''''''''''
wsPivot.Select
ActiveSheet.PivotTables("PivotTable9").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
wsPivotM.Select
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
Dim SpendReport As Workbook
Set SpendReport = ActiveWorkbook.Sheets(1).Range("A1").Value
Workbooks.Add
''''''''''''''''''''''''''''''
'Create new distributable workbook'
''''''''''''''''''''''''''''''
wsPivotM.Copy
wbS.Activate
wsSplitBU.Copy After:=SpendReport.Sheets(1)
wbS.Activate
wsLocalS.Copy After:=SpendReport.Sheets(2)
wbS.Activate
wsPlantSp.Copy After:=SpendReport.Sheets( _
3)
Range("B4:M8").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Localization Spend").Select
Range("B3:M19").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L1:M1").Select
Application.CutCopyMode = False
Selection.Copy
Range("L2").Select
ActiveSheet.Paste
Sheets("Split BU (HUTAS)").Select
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 3
Range("C18:N46").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M1:N1").Select
Application.CutCopyMode = False
Selection.Copy
Range("M2").Select
ActiveSheet.Paste
Sheets("Pivot").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=SpendReport & ".xls"
End Sub
1 answers
solution1
1 2019-12-12 12:04:31
Here is the code that I assume you have tried to create. There are a lot of not clear details like sheets' references to workbooks for me to be sure that I do what you planned to have.
I've divided code into blocks in effort to make it more readable. So read comments, think about and don't forget that this logic is only assumption.
Sub Data_Cleanser()
Application.ScreenUpdating = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Declaring the source workbook '
' source WB will be the one that holds this code, '
' I assume that this is the - Workbooks("Spend automator.xlsm") '
Dim sourceWB As Workbook '
Set sourceWB = ThisWorkbook '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Declaring sheets to copy as per provided code: '
' wsPivotM.Copy '
' wsSplitBU.Copy '
' wsLocalS.Copy '
' wsPlantSp.Copy '
'
Dim wsPivotM As Worksheet '
Set wsPivotM = sourceWB.Sheets("Pivot") '
'
Dim wsSplitBU As Worksheet '
Set wsSplitBU = sourceWB.Sheets("Split BU (HUTAS)") '
'
Dim wsLocalS As Worksheet '
Set wsLocalS = sourceWB.Sheets("Localization Spend") '
'
Dim wsPlantSp As Worksheet '
Set wsPlantSp = sourceWB.Sheets("Bedok, Changi, Bandung Spend") '
'
' I can't determine which workbook holds these sheets, '
' so I assume that it is also in a source workbook '
Dim wsRaw As Worksheet '
Set wsRaw = sourceWB.Sheets("RAW DATA") '
Dim wsPivot As Worksheet '
Set wsPivot = sourceWB.Sheets("Pivot_RAW_DATA") '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Populate formula - I didn't change anything here '
' because I have no idea what do you need it for '
'
Dim lastRowRD As Long '
lastRowRD = wsRaw.Cells(Rows.Count, "A").End(xlUp).Row '
'
[Aa1].Resize(lastRowRD - 1, 1).FormulaR1C1 = ("BU Correction Generator") '
[Aa2].Resize(lastRowRD - 1, 1).Formula = ("=VLOOKUP(N2,'BU CORRECTOR REFERENCE'!$A:$C,3,FALSE)") '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Refresh Pivots '
With wsPivot '
.PivotTables("PivotTable9").PivotCache.Refresh '
.PivotTables("PivotTable1").PivotCache.Refresh '
.PivotTables("PivotTable2").PivotCache.Refresh '
End With '
'
wsPivotM.PivotTables("PivotTable3").PivotCache.Refresh '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This is useless code which generates your error: '
'Dim SpendReport As Workbook '
'Set SpendReport = ActiveWorkbook.Sheets(1).Range("A1").Value '
'Workbooks.Add '
'
' you cannot assign a cell value to a Workbook object '
' if you mean that cell ActiveWorkbook.Sheets(1).Range("A1").Value '
' contains the FileName - you should use it in a different way '
' (I assume that this sheet is also on the source WorkBook): '
'
'Dim targetWB As Workbook '
'Set targetWB = Workbooks.Add(sourceWB.Sheets(1).Range("A1").Value & ".xls") ' -> If you decide to use this approach-
' |
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
'Create new distributable workbook ' |
Dim targetWB As Workbook '<---------------- Do not use this part --------------------------------------------
Set targetWB = Workbooks.Add '
'''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copying sheetes as per provided code '
'
'wsPivotM.Copy '
'wbS.Activate '
'wsSplitBU.Copy After:=SpendReport.Sheets(1) '
'wbS.Activate '
'wsLocalS.Copy After:=SpendReport.Sheets(2) '
'wbS.Activate '
'wsPlantSp.Copy After:=SpendReport.Sheets(3) '
With targetWB '
wsPivotM.Copy after:=.Sheets(.Sheets.Count) ' <- I'm not sure that you won't copy reference to Pivot table in source WB
wsSplitBU.Copy after:=.Sheets(.Sheets.Count) '
wsLocalS.Copy after:=.Sheets(.Sheets.Count) '
wsPlantSp.Copy after:=.Sheets(.Sheets.Count) '
End With '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The code below looks like complete mess '
'
'Range("B4:M8").Select '
'Selection.Copy '
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ '
' :=False, Transpose:=False '
'Sheets("Localization Spend").Select '
'Range("B3:M19").Select '
'Application.CutCopyMode = False '
'Selection.Copy '
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ '
' :=False, Transpose:=False '
'Range("L1:M1").Select '
'Application.CutCopyMode = False '
'Selection.Copy '
'Range("L2").Select '
'ActiveSheet.Paste '
'Sheets("Split BU (HUTAS)").Select '
'ActiveWindow.ScrollColumn = 9 <- This is just a macro recorder's stuff,'
'ActiveWindow.ScrollColumn = 3 you don't need it in your code '
'Range("C18:N46").Select '
'Application.CutCopyMode = False '
'Selection.Copy '
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ '
' :=False, Transpose:=False '
'Range("M1:N1").Select '
'Application.CutCopyMode = False '
'Selection.Copy '
'Range("M2").Select '
'ActiveSheet.Paste '
'Sheets("Pivot").Select '
'Application.CutCopyMode = False '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Here is what I assume the code above should do: '
'
' Reset sheets (as those copied have same name, but in another workbook) '
' to have short and exact names '
With targetWB '
Set wsPivotM = .Sheets("Pivot") '
Set wsSplitBU = .Sheets("Split BU (HUTAS)") '
Set wsLocalS = .Sheets("Localization Spend") '
Set wsPlantSp = .Sheets("Bedok, Changi, Bandung Spend") '
End With '
'
' As far as I understand - you want to replace formulas with just values '
With wsPlantSp '
.Range("B4:M8").Copy '
.Range("B4").PasteSpecial Paste:=xlPasteValues ' Operation:=xlNone, SkipBlanks:=False, Transpose:=False - these are default
End With ' values, no need to specify it
'
With wsLocalS '
.Range("B3:M19").Copy '
.Range("B3").PasteSpecial Paste:=xlPasteValues '
.Range("L1:M1").Copy .Range("L2") '
End With '
'
With wsSplitBU '
.Range("C18:N46").Copy '
.Range("C18").PasteSpecial Paste:=xlPasteValues '
.Range("M1:N1").Copy .Range("M2") '
End With '
'
Application.ScreenUpdating = True ' '
wsPivotM.Activate '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You will not need to save the workbook in case you have used
' Set targetWB = Workbooks.Add(sourceWB.Sheets(1).Range("A1").Value & ".xls")
' described it in the code above
targetWB.SaveAs Filename:=sourceWB.Sheets(1).Range("A1").Value & ".xls"
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.
Related Question
Excel VBA: Copying multiple sheets into new workbook
VBA Copying Multiple sheets selected Data ranges to a workbook by creating a new workbook automatically
Remove Macros when copying sheets to new workbook
Excel VBA Copying Sheets to a New Workbook and emailing the New Workbook in Outlook
Macro Copying sheets into a new workbook, editing workbook and Save As
Error when creating new workbook with vba, copying 2 of many sheets
Copying multiple worksheets to a single new workbook
How to copy multiple sheets to a new workbook?
Copy multiple specific sheets to new workbook
Copy pasting multiple sheets into new workbook
Related Tags