Question

好的，我发现代码正在从已关闭的工作簿中读取数据，并且可以将其粘贴到该工作簿中的sheet2中。这是我的新代码：

    Sub Copy456()

    Dim iCol As Long
    Dim iSht As Long
    Dim i As Long



    'Fpath = "C:\testy" ' change to your directory
    'Fname = Dir(Fpath & "*.xlsx")

    Workbooks.Open ("run1.xlsx")

    For i = 1 To Worksheets.Count
        Worksheets(i).Activate

     ' Loop through columns
     For iSht = 1 To 6 ' no of sheets
     For iCol = 1 To 6 ' no of columns

        With Worksheets(i).Columns(iCol)

            If ((.Cells(1, 1).Value = "Time")) Then ' if first cell=Time then copy two columns
                Range(.Cells(1, 2), .End(xlDown)).Select
                Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)
                Worksheets("Sheet2").Cells(i * 2 + 1) = Worksheets(i).Name
            Else
                ' do nothing

            End If
        End With

    Next iCol
    Next iSht
Next i
End Sub

但是一旦我改变了那部分代码：

            Selection.Copy Destination:=Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

进入该代码：

   Destination:=Workbooks("general.xlsx").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

它停止工作发出错误：“订阅超出范围”。文件general.xlsx也是一个空文件，也会关闭。

当我将代码更改为：

`Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

然后发出错误：“1004无法更改合并单元格的一部分”。文件“Your Idea.xlsm”是我运行此脚本的文件。

有关此问题的任何帮助吗？

Answer 1

尝试在制作电子表格时避免合并的单元格，因为在我简陋的经历中，他们可以回来咬你。这就是我粗略地将数据从一个工作表复制到另一个工作表的方法，你需要在迭代和设置所需的实际范围时实现自己的逻辑，但它应该给你一些想法，正如我在评论中所说的更明确设置范围时避免magic。

AFAIK你必须打开文件才能用VBA操纵它们

Sub makeCopy()
    ' turn off features
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' some constants
    Const PATH = ""
    Const FILE = PATH & "FOO.xls"

    ' some variables
    Dim thisWb, otherWb As Workbook
    Dim thisWs, otherWs As Worksheet
    Dim i As Integer:   i = 0
    Dim c As Integer:   c = 0
    Dim thisRg, otherRg As Range

    ' some set-up
    Set thisWb = Application.ActiveWorkbook
    Set otherWb = Application.Workbooks.Open(FILE)

    ' count the number of worksheets in this workbook
    For Each thisWs In thisWb.Worksheets
        c = c + 1
    Next thisWs

    ' count the number of worksheets in the other workbook
    For Each thisWs In otherWb.Worksheets
        i = i + 1
    Next thisWs

    ' add more worksheets if required
    If c <= i Then
        For c = 1 To i
            thisWb.Worksheets.Add
        Next c
    End If

    ' reset i and c
    i = 0:    c = 0

    ' loop through other workbooks worksheets copying
    ' their contents into this workbook
    For Each otherWs In otherWb.Worksheets
        i = i + 1
        Set thisWs = thisWb.Worksheets(i)

        ' ADD YOUR OWN LOGIC FOR SETTING `thisRg` AND
        ' `otherRg` TO THE APPROPRIATE RANGE
        Set thisRg = thisWs.Range("A1:  C100")
        Set otherRg = otherWs.Range("A1:  C100")

        otherRg.Copy (thisRg)

    Next otherWs

    ' save this workbook
    thisWb.Save

    ' clean up  
    Set otherWs = Nothing
    otherWb.Close
    Set otherWb = Nothing
    Set thisWb = Nothing
    Set thisWs = Nothing

    ' restore features
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate

End Sub

从已关闭的工作簿复制excel VBA

1 个答案: