Question

我试图将一个工作簿中单行的几个片段复制到另一个工作簿，这是我的脚本，不确定但是我得到了一个（运行时错误＆＃39; 91＆＃39;：对象变量或未设置块变量）。

Sub copyToXml()
Set xlBook1 = Workbooks.Open("C:\Users\roperalta\Desktop\Book1.xlsx", 0, True)
Set xlBook2 = Workbooks.Open("C:\Users\roperalta\Desktop\PBJ_Excel_to_XML_Template_v_2_00_3.xlsx", 0, True)

xlBook2.Sheets("Header").Range("B3:D3").Value = xlBook1.Sheets("Sheet0 (2)").Range("B2:D2")

xlBook1.Close
End Sub

错误来自第5行。

xlBook2.Sheets("Header").Range("B3:D3").Value = xlBook1.Sheets("Sheet0 (2)").Range("B2:D2")

这是脚本：

Dim xlBook, xlApp 

Set xlApp = createObject("Excel.Application")
xlApp.Visible = True
xlApp.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open("C:\Users\roperalta\Desktop\PBJ_Excel_to_XML_Template_v_2_00_3.xlsx", 0, False)
Set xlmodule = xlBook.VBProject.VBComponents.Add(1)
strCode = _
"Sub copyToXml()" & vbCr & _
"    Set xlBook1 = Workbooks.Open(""C:\Users\roperalta\Desktop\Book1.xlsx"", 0, False)" & vbCr & _
"    Set xlBook2 = Workbooks.Open(""C:\Users\roperalta\Desktop\PBJ_Excel_to_XML_Template_v_2_00_3.xlsx"", 0, False)" & vbCr & _
"" & vbCr & _
"    xlBook2.Sheets(""Header"").Range(""B3:D3"").Value = xlBook1.Sheets(""Sheet0 (2)"").Range(""B2:D2"").Value" & vbCr & _
"" & vbCr & _
"    xlBook1.Close" & vbCr & _
"End Sub"
xlmodule.CodeModule.AddFromString strCode

xlBook.Save
xlApp.Run "Module1.copyToXml"
Set xlApp = Nothing
Set xlBook = Nothing

编辑过的脚本：

"    Set xlBook2 = Workbooks(""C:\Users\roperalta\Desktop\PBJ_Excel_to_XML_Template_v_2_00_3.xlsx"")" & vbCr & _

Answer 1

试试这个VBS：

    Const FILE1 = "C:\Users\roperalta\Desktop\Book1.xlsx"
    Const FILE2 = "C:\Users\roperalta\Desktop\PBJ_Excel_to_XML_Template_v_2_00_3.xlsx"

    Dim xlApp 
    Set xlApp = CreateObject("Excel.Application")

    Dim wb1, wb2
    With xlApp
        .Visible = False
        .DisplayAlerts = False
        Set wb1 = .Workbooks.Open(FILE1, 0, False)
        Set wb2 = .Workbooks.Open(FILE2, 0, False)
    End With

    Dim ws1, ws2
    Set ws1 = wb1.Sheets("Sheet0 (2)")
    Set ws2 = wb2.Sheets("Header")

        ws2.Range("B3:D3").Value2 = ws1.Range("B2:D2").Value2

    wb2.Save
    wb1.Close
    'wb2.Close
    'xlApp.Quit

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb1 = Nothing
    'Set wb2 = Nothing
    'Set xlApp = Nothing

VBA将行复制到VBScript的另一个工作簿

1 个答案: