копирование из закрытой книги excel VBA

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