selection.copy导致selection.pastespecial不工作。excelvba

我会保持这个速度。我在其他项目中使用了它的一些细微变化。注释掉的range3.copy来自我的上一个项目

我当前在获取selection.copy时遇到问题，请将所选范围复制到正确的工作簿中。我试过很多东西，有些是在剧本中写的。但是我无法得到选择。复制工作 .range.copy将起作用并填充剪贴板。但我还没有弄明白如何使用.copy粘贴特殊内容

我尝试输出到变量。。没有像我想的那样起作用。我觉得我必须在工作簿选择/激活中遗漏一些内容，但我不知道是什么。提前感谢您的建议或帮助。。我会继续努力，看看是否能解决这个问题

Sub parse()

    Dim strPath As String, strPathused As String
    Dim objexcel As Excel.Application

    Set objexcel = CreateObject("Excel.Application")
    With objexcel
        .Visible = True
        .DisplayAlerts = False
    End With

    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Excel.Workbook
            Set objWorkbook = objexcel.Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            objexcel.Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Excel.Worksheet, SRCrange1 As Excel.Range, SRCrange2 As Excel.Range

            Set SRCwb = objWorkbook.Worksheets("plan") 'sjh -> to me wb implies wb, but you set it to a worksheet (could be a style thing, but worth pointing out
            Set SRCrange1 = objWorkbook.Worksheets("plan").Range("b6:i7")
            Set SRCrange2 = objWorkbook.Worksheets("plan").Range("k6:p7")


            'Range management sourcebook
            Set DSTwb = Excel.Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)


            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

objexcel.Quit

End Sub

这是本期的第一部分。SRCrange1.select然后selection.copy实际上并不复制指定的选择。完整代码如下所示

      Dim MyColumn As String
    Dim Here As String
    Dim AC As Variant

     'SRCrange1.copy  ': This will copy to clipboard

       'objworkbook.Worksheets("plan").Range("b6:h7").Select  no change from SRCrange1.select
       'SRCrange1.Select 'the range does select
        'Selection.copy  '  this will cause a activecell in DSTwb _
        to be copied neither direct reference to SRCrange1.select or .avtivate will change that.


DSTwb.Select
             DSTwb.Range("b2").Select
             Here = ActiveCell.Address
             MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
             Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
             lastrow.Select
             Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

完整代码

Sub parse()
Dim strPath As String
Dim strPathused As String


'On Error Resume Next


Set objexcel = CreateObject("Excel.Application")
objexcel.Visible = True
objexcel.DisplayAlerts = False
strPath = "C:\prodplan"
Set objfso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objfso.GetFolder(strPath)


'Loop through objWorkBooks
For Each objfile In objFolder.Files

    If objfso.GetExtensionName(objfile.Path) = "xlsx" Then
        Set objworkbook = objexcel.Workbooks.Open(objfile.Path)
                                ' Set path for move to at end of script
                                strPathused = "C:\prodplan\used\" & objworkbook.Name

'open WB to consolidate too
                        Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

'Range management sourcebook
        Set SRCwb = objworkbook.Worksheets("plan")
        Set SRCrange1 = objworkbook.Worksheets("plan").Range("b6:i7")
        Set SRCrange2 = objworkbook.Worksheets("plan").Range("k6:p7")
        'Set SRCrange3 = objworkbook.Worksheets("").Range("")

'Range management sourcebook
        Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")
        'Set DSTrange1 = Workbooks("plancon.xlsx").Worksheets("data").Range("")
        'Set DSTrange2 = Workbooks("plancon.xlsx").Worksheets("data").Range("")
        'Set DSTrange3 = Workbooks("plancon.xlsx").Worksheets("data").Range("")

'start header dates and shifts copy from objworkbook to consolidated WB
                SRCwb.Select
                'On Error Resume Next
                'SRCwb.Cells.UnMerge

Dim MyColumn As String
Dim Here As String
Dim AC As Variant

 'SRCrange1.copy  ': This will copy to clipboard

   'objworkbook.Worksheets("plan").Range("b6:h7").Select  no change from SRCrange1.select
   'SRCrange1.Select 'the range does select
    'Selection.copy  '  this will cause a activecell in DSTwb _
    to be copied neither direct reference to SRCrange1.select or .avtivate will change that.
         DSTwb.Select
         DSTwb.Range("b2").Select
         Here = ActiveCell.Address
         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
         lastrow.Select
         Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True


   SRCrange2.Select
    Selection.copy
         Workbooks("plancon.xlsx").Worksheets("sheet1").Select
         ActiveSheet.Range("b2").Select
         ActiveSheet.Range("b2").Activate
         Here = ActiveCell.Address
         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
         lastrow.Select
         Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

'    range3.copy
'         Workbooks("data.xlsx").Worksheets("sheet1").Activate
'         ActiveSheet.Range("c2").Select
'         ActiveSheet.Range("c2").Activate
'         Here = ActiveCell.Address
'         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
'         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
'         ActiveSheet.Paste Destination:=lastrow


                    'start loop for objworkbook name copy to field in plancon corisponding with date/shift and copy/paste select row data.

    objworkbook.Close False
                        'Move proccesed file to new Dir

    OldFilePath = objfile 'original file location
        NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

End If

Next

objexcel.Quit




End Sub

---

如果可以直接复制范围，则无需选择范围然后复制所选内容：

objworkbook.Worksheets("plan").Range("b6:h7").Copy
same_or_different_Range.PasteSpecial Paste:=xlPasteValues, _
    operation:=xlNone, skipblanks:=False, Transpose:=True

---

如果可以直接复制范围，则无需选择范围然后复制所选内容：

objworkbook.Worksheets("plan").Range("b6:h7").Copy
same_or_different_Range.PasteSpecial Paste:=xlPasteValues, _
    operation:=xlNone, skipblanks:=False, Transpose:=True

---

首先，相对欢迎如此

第二，为您提供一些技巧，使VBA编程更轻松：

使用Option Explicit并始终标注和声明变量类型

命名变量时，使其易于理解和遵循。因此，如果您要创建一个工作表变量，请将其称为wksCopy。或者，如果要命名工作簿，请将其命名为wkbCopyTo

您不需要使用.Select和.Activate，而是可以直接使用对象。此外，通过声明适当的变量类型，这使得在每次需要时在代码中使用这些对象更加容易

我不知道您是否在Excel或其他应用程序（如Access）中运行此代码，但如果您在Excel中，则无需创建Excel对象，因为您可以直接使用Excel应用程序。如果您使用Access/Word/PPT等启动代码，请忽略此项

所有这些技巧使您的代码在调试和编写时更易于阅读、理解和遵循

综上所述，我已经重构了上面的代码，以合并这些原则中的大部分（我保留了所有变量名的完整性，这样您就不会在任何重新命名中迷失方向。）如果这种重新编写不能直接解决您的问题=这可能不会，因为编写时代码对我来说有点混乱，我认为，当您调试时，您可以更容易地遵循和理解它，并找出它没有达到预期效果的地方。还有，我想如果你不明白的话，我们会帮你的

Sub parse()

    Dim strPath As String, strPathused As String
    Dim objexcel As Excel.Application

    Set objexcel = CreateObject("Excel.Application")
    With objexcel
        .Visible = True
        .DisplayAlerts = False
    End With

    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Excel.Workbook
            Set objWorkbook = objexcel.Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            objexcel.Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Excel.Worksheet, SRCrange1 As Excel.Range, SRCrange2 As Excel.Range

            Set SRCwb = objWorkbook.Worksheets("plan") 'sjh -> to me wb implies wb, but you set it to a worksheet (could be a style thing, but worth pointing out
            Set SRCrange1 = objWorkbook.Worksheets("plan").Range("b6:i7")
            Set SRCrange2 = objWorkbook.Worksheets("plan").Range("k6:p7")


            'Range management sourcebook
            Set DSTwb = Excel.Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)


            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

objexcel.Quit

End Sub

如果您在Excel中运行此功能，请更新。只需使用下面的代码。我在回答中留下了这两个代码，以防您不是从Excel运行此代码

Option Explicit

Sub parse()

    Application.DisplayAlerts = False

    Dim strPath As String, strPathused As String
    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Workbook
            Set objWorkbook = Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Worksheet, SRCrange1 As Range, SRCrange2 As Range

            Set SRCwb = objWorkbook.Worksheets("plan")
            Set SRCrange1 = SRCwb.Range("b6:i7")
            Set SRCrange2 = SRCwb.Range("k6:p7")

            'Range management sourcebook
            Dim DSTwb As Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

End Sub

---

首先，相对欢迎如此

第二，为您提供一些技巧，使VBA编程更轻松：

使用Option Explicit并始终标注和声明变量类型

命名变量时，使其易于理解和遵循。因此，如果您要创建一个工作表变量，请将其称为wksCopy。或者，如果要命名工作簿，请将其命名为wkbCopyTo

您不需要使用.Select和.Activate，而是可以直接使用对象。此外，通过声明适当的变量类型，这使得在每次需要时在代码中使用这些对象更加容易

我不知道您是否在Excel或其他应用程序（如Access）中运行此代码，但如果您在Excel中，则无需创建Excel对象，因为您可以直接使用Excel应用程序。如果您使用Access/Word/PPT等启动代码，请忽略此项

所有这些技巧使您的代码在调试和编写时更易于阅读、理解和遵循

综上所述，我已经重构了上面的代码，以合并这些原则中的大部分（我保留了所有变量名的完整性，这样您就不会在任何重新命名中迷失方向。）如果这种重新编写不能直接解决您的问题=这可能不会，因为编写时代码对我来说有点混乱，我认为，当您调试时，您可以更容易地遵循和理解它，并找出它没有达到预期效果的地方。还有，我想如果你不明白的话，我们会帮你的

Sub parse()

    Dim strPath As String, strPathused As String
    Dim objexcel As Excel.Application

    Set objexcel = CreateObject("Excel.Application")
    With objexcel
        .Visible = True
        .DisplayAlerts = False
    End With

    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Excel.Workbook
            Set objWorkbook = objexcel.Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            objexcel.Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Excel.Worksheet, SRCrange1 As Excel.Range, SRCrange2 As Excel.Range

            Set SRCwb = objWorkbook.Worksheets("plan") 'sjh -> to me wb implies wb, but you set it to a worksheet (could be a style thing, but worth pointing out
            Set SRCrange1 = objWorkbook.Worksheets("plan").Range("b6:i7")
            Set SRCrange2 = objWorkbook.Worksheets("plan").Range("k6:p7")


            'Range management sourcebook
            Set DSTwb = Excel.Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)


            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

objexcel.Quit

End Sub

如果您在Excel中运行此功能，请更新。只需使用下面的代码。我在回答中留下了这两个代码，以防您不是从Excel运行此代码

Option Explicit

Sub parse()

    Application.DisplayAlerts = False

    Dim strPath As String, strPathused As String
    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Workbook
            Set objWorkbook = Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Worksheet, SRCrange1 As Range, SRCrange2 As Range

            Set SRCwb = objWorkbook.Worksheets("plan")
            Set SRCrange1 = SRCwb.Range("b6:i7")
            Set SRCrange2 = SRCwb.Range("k6:p7")

            'Range management sourcebook
            Dim DSTwb As Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

End Sub

---

仅添加到其他答案：对于连续范围，此操作不需要使用copy（粘贴特殊>>值+转置）

---

仅添加到其他答案：对于连续范围，此操作不需要使用copy（粘贴特殊>>值+转置）

---

粘贴时LastRow.Address（外部：=True）是什么？为什么要使用单独的Excel实例打开其他工作簿？你不需要为这个任务这么做。@TimWilliams+1。这正是他的代码失败的原因，我相信，基于这一行，

这将导致DSTwb中出现activecell

，因为他在Excel实例中设置了DSTwb，但他想为activecell引用SRCrange1，但它在Excel的另一个实例中。见下面我的答案。我将对其进行更新，以完全删除Excel引用。我让它与excel引用一起正常工作，因为我不确定他是从excel加载的。粘贴时LastRow.Address（外部：=True）是什么？为什么要使用excel的单独实例打开其他工作簿？你不需要为这个任务这么做。@TimWilliams+1。我相信这正是他的代码失败的原因，基于这一点<