无意中创建了新工作簿

时间:2013-01-31 14:11:14

标签: excel-vba vba excel

我正在尝试从工作簿(“InventoryControlSystemV1.1”)复制工作表(“ReceivingRecords”)并将其粘贴到新工作簿(“RecordBook”)中。我创建了一个名为“Temp.xls”的临时工作簿,它允许我使用SaveCopyAs方法创建我的新工作簿“RecordBook”。

当我运行程序时,“RecordBook”按预期创建,但在单元格A1中只有一个条目(文本'InventoryControlSystemV1.1.xls')。

然后,我要复制的工作表将粘贴到一个未命名的新工作簿中。 我无法弄清楚这个新工作簿的创建地点和原因。

以下是此过程的代码:

Sub WriteReceivingToRecords()

    Dim UsedRng As Range
    Dim LastCol As Long
    Dim BeginDate, EndDate
    Dim NameString
    Dim FormatBeginDate, FormatEndDate
    Dim BackupQuest As Integer
    Dim BackupMsg As String

    'Confirmation dialog box to avoid mistakes
    BackupMsg = "This will create a new workbook for the period" & vbNewLine
    BackupMsg = BackupMsg & " since the last backup was made, and will clear" & vbNewLine
    BackupMsg = BackupMsg & " the receiving records in this workbook." & vbNewLine & vbNewLine
    BackupMsg = BackupMsg & "Are you sure you want to back up the receiving records?"
    BackupQuest = MsgBox(BackupMsg, vbYesNo, "Back-up Records")

    If BackupQuest = vbNo Then
        Exit Sub
    Else

    '   Find start and end dates of receiving - To use for worksheet title
        Workbooks("InventoryControlSystemV1.1.xls").Activate
        Worksheets("ReceivingRecords").Activate
        Set UsedRng = ActiveSheet.UsedRange
        LastCol = UsedRng(UsedRng.Cells.Count).Column
        Do While Cells(2, LastCol) = ""
                LastCol = LastCol - 1
        Loop
        EndDate = Cells(2, LastCol).Text
        BeginDate = Cells(2, 2).Text

        FormatBeginDate = Format(BeginDate, "d mmmm yy")
        FormatEndDate = Format(EndDate, "d mmmm yy")
        NameString = "M-Props Receiving Records " & FormatBeginDate & " To " _
            & FormatEndDate & ".xls"



        Workbooks("InventoryControlSystemV1.1.xls").Sheets("ReceivingRecords").Copy

        Workbooks.Open Filename:="Temp.xls"
        Workbooks("Temp.xls").Activate
        Workbooks("Temp.xls").Worksheets("Sheet1").Paste _
            Destination:=Workbooks("Temp.xls").Worksheets("Sheet1").Range("A1")

        Workbooks("Temp.xls").SaveCopyAs NameString & ".xls"
        Workbooks("Temp.xls").Close False

    End If

End Sub

1 个答案:

答案 0 :(得分:0)

替换

Workbooks("InventoryControlSystemV1.1.xls").Sheets("ReceivingRecords").Copy

Workbooks("InventoryControlSystemV1.1.xls").Sheets("ReceivingRecords").Cells.Copy

应该这样做。