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

Question

Хорошо, я дошел до того, что код считывает данные из закрытой книги и может вставлять их в лист2 в этой книге. Это мой новый код:

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