Question

我正在尝试自动化涉及将粘贴数据从一个工作簿复制到新工作簿的过程。我已经能够将下面的代码放在这里的论坛和其他地方的片段中。但是，我在尝试运行该过程时收到“运行时错误1004”。有什么建议吗？

Option Explicit
Dim wbI As Workbook, wbO As Workbook, wsI As Worksheet, wsO As Worksheet
Dim wbName As String
Sub transferit()

wbName = InputBox("Enter name", "name")

'~~> Source/Input Workbook
Set wbI = ThisWorkbook
'~~> Set the relevant sheet from where you want to copy
Set wsI = wbI.Sheets("Sheet1")

'~~> Destination/Output Workbook
Set wbO = Workbooks.Add
'~~> Set the relevant sheet to where you want to paste
Set wsO = wbO.Sheets("Sheet1")

With wbO
    '~~>. Save the file
    .SaveAs Filename:="D:\Documents\Output\wbName
End With

With wsI
   Call RangeSelectionPrompt
   Selection.Copy
End With

With wsO
    '~~> Paste it in say Cell A1. Change as applicable
    .Range("A1").PasteSpecial xlPasteValues
End With
End Sub

Sub RangeSelectionPrompt()
    Dim rng As Range
    Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
End Sub

Answer 1

您需要全局变量吗？这不太可能，将它们移到Sub中。您没有为.SaveAs正确连接文件名，并且您没有复制您期望的内容...... 这是我的代码，仍然可以控制错误。

    Sub transferit()

        Dim wbI As Workbook, wbO As Workbook, wsI As Worksheet, wsO As Worksheet
        Dim wbName As String
        wbName = InputBox("Enter name", "name")

        '~~> Source/Input Workbook
        Set wbI = ThisWorkbook
        '~~> Set the relevant sheet from where you want to copy
        Set wsI = wbI.Sheets("Sheet1")

        '~~> Destination/Output Workbook
        Set wbO = Workbooks.Add
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")

        With wbO
            '~~>. Save the file
            .SaveAs Filename:="D:\Documents\Output\" & wbName
        End With

        RangeSelectionPrompt.Copy

        With wsO
            '~~> Paste it in say Cell A1. Change as applicable
            .Range("A1").PasteSpecial xlPasteValues
        End With
    End Sub

    Function RangeSelectionPrompt() As Range
        Set RangeSelectionPrompt = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
    End Function


    RangeSelectionPrompt.Copy

    With wsO
        '~~> Paste it in say Cell A1. Change as applicable
        .Range("A1").PasteSpecial xlPasteValues
    End With
End Sub

Function RangeSelectionPrompt() As Range
    Set RangeSelectionPrompt = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
End Function

从一个工作簿到另一个工作簿的复制粘贴选择

1 个答案: