从关闭的工作簿中复制Excel VBA [英] copying from closed workbook excel VBA

问题描述

好吧，我到达了从封闭的工作簿中读取数据并将其粘贴到该工作簿的sheet2中的地步。这是我的新代码：

Ok I get to the point where code is reading data from closed workbook and can paste it into sheet2 in that workbook. This is my new code:

    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

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

But once I change that part of code:

            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是一个也关闭的空文件。

It stop working issuing error: "subscription is out of range". File general.xlsx is an empty file which is closed as well.

当我将代码更改为：

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

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

It then issue an error: "1004 cannot change part of merged cell". File "Your Idea.xlsm" is the file from which I running this script.

对这个问题有帮助吗？

推荐答案

在制作电子表格时，请尽量避免合并单元格，就像我的卑鄙经历一样，它们可能会再次咬住您。这就是我大致将数据从一张纸复制到另一张纸的方式，当您遍历并设置所需的实际范围时，您将需要实现自己的逻辑，但它应该给您一些想法，正如我在评论中所说的那样设置范围时，请避免使用魔术。

try to avoid merged cells when making spreadsheets as in my humble experience they can come back to bite you. This is how I would roughly go about copying data from one sheet to another you will need to implement your own logic when iterating through and setting the actual ranges you require but it should give you some idea, as I said in my comment be more explicit when setting ranges and avoid 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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！