Копирование нескольких листов в новую рабочую книгу (для распространения)

Question

Редактирование сообщения для нового кода, который выдает ошибку "Недопустимый квалификатор"

У меня проблемы с редактированием этого кода VBA после записи макроса. Код макроса приведен ниже.

Теперь я получаю сообщение об ошибке "объект не определен" в этой строке "Dim SpendReport As Set Workbook Set SpendReport = ActiveWorkbook.Sheets (1) .Range (" A1 "). Значение Workbooks.Add"

Сильно подозреваю, что определение моей переменной неверно?

Идея здесь состоит в том, чтобы скопировать эти 4 листа в целую новую книгу и затем вставить их в качестве значений перед сохранением.

Сможет ли эксперт здесь помочь с редактированием кода, чтобы сделать его более гибким?

Спасибо!

Новый отредактированный код с ошибкой объекта:

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

Answer 1

Вот код, который я предполагаю , который вы пытались создать. Есть много неясных деталей, таких как ссылки на листы на рабочие книги, чтобы я был уверен, что я делаю то, что планировал сделать.

Я разделил код на блоки, чтобы сделать его более читабельным. Так что читайте комментарии, думайте и не забывайте, что эта логика является лишь предположением.

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