将两个工作表作为值复制到新工作簿中,然后使用今天的日期保存并关闭工作簿

时间:2018-02-19 17:23:05

标签: excel-vba vba excel

当使用我在stackoverflow上找到的所有不同的例子时,他们给了我一个复杂的任务,仍然需要点击鼠标来确认它可以粘贴数据。我也在努力让整个事情在VBA代码的一个部分中运行。

Public Sub copySheets()
Dim wkb As Excel.Workbook
Dim newWkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim newWks As Excel.Worksheet
Dim sheets As Variant
Dim varName As Variant
'------------------------------------------------------------


'Define the names of worksheets to be copied.
sheets = VBA.Array("Analysis - London", "London - Commercial")


'Create reference to the current Excel workbook and to the destination workbook.
Set wkb = Excel.ThisWorkbook
Set newWkb = Excel.Workbooks.Add


For Each varName In sheets

    'Clear reference to the [wks] variable.
    Set wks = Nothing

    'Check if there is a worksheet with such name.
    On Error Resume Next
    Set wks = wkb.Worksheets(VBA.CStr(varName))
    On Error GoTo 0


    'If worksheet with such name is not found, those instructions are skipped.
    If Not wks Is Nothing Then

        'Copy this worksheet to a new workbook.
        Call wks.Copy(newWkb.Worksheets(1))

        'Get the reference to the copy of this worksheet and paste
        'all its content as values.
        Set newWks = newWkb.Worksheets(wks.Name)
        With newWks
            Call .Cells.Copy
            Call .Range("A1").PasteSpecial(Paste:=xlValues)
        End With

    End If

Next
ActiveWorkbook.SaveCopyAs Filename:=("C:\Users\\My stuff\Forecast" & Format(Now(), "YYYYMMDD") & " Forecasting" & ".xlsm")

由于

1 个答案:

答案 0 :(得分:0)

替换

  With newWks
        Call .Cells.Copy
        Call .Range("A1").PasteSpecial(Paste:=xlValues)
    End With

 Dim c as range
 For each c in newwks.usedrange
     c.formula = c.value
 next c