3

ワークブック ("InventoryControlSystemV1.1") からワークシート ("RecomingRecords") をコピーして、新しいワークブック ("RecordBook") に貼り付けようとしています。「Temp.xls」という名前の一時ワークブックを作成しました。これにより、SaveCopyAs メソッドを使用して新しいワークブック「RecordBook」を作成できます。

手順を実行すると、意図したとおりに「RecordBook」が作成されますが、セル A1 には 1 つのエントリ (「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
4

1 に答える 1

0

交換

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

と

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

それはそれを行う必要があります。

于 2013-06-19T15:27:44.130 に答える