Excel VBA: Копировать строку из другой книги и вставить в основную книгу

Question

У меня есть много файлов excel одной структуры в одной папке (Test01, Test02, Test03).

Я создал еще один файл excel в той же папке, которая должна извлекать информацию из файла excel (Результаты).

В каждом тестовом файле есть определенный столбец, который мне нужно скопировать и вставить в строку в файле результатов.

Я пытаюсь создать инструмент или макрос, который может одним нажатием кнопки извлечь один и тот же столбец из каждого файла и вставить его в новую строку в файле результатов.

Я ничего не могу изменить в тестовых файлах, и это нужно делать автоматически, не открывая каждый файл. Также к папке будут добавлены новые тестовые файлы (Test04, Test05 и т. Д.), Чтобы функция могла извлекать новые файлы.

Мой код не работает, и вместо этого, получает сообщение об ошибке во время выполнения:

Private Sub CommandButton1_Click() 

'Dim info 

'info = isWorkBookopen("C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") 
'If info = False Then 
Workbooks.Open Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm" 
'End If 

Worksheets(Sheet2).Activate 'This is giving me a runtime error 

Range("C2:C10").Copy 

'Need functions to paste into Results.xlsm 

End Sub 

На стороне записки, моя isWorkBookopen функция не работает, и это не делает признайте его как функцию. Вот почему я прокомментировал эти строки.

Answer 1

Постарайтесь сделать все явное

Private Sub CommandButton1_Click() 

Dim wbSource as Workbook 
Dim wbTarget as Workbook  
Dim shSource as Worksheet 
Dim shTarget as Worksheet 

' Open workbook to copy from as readonly 
Set wbSource = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm", ReadOnly:=true) 

' The data is copies to this workbook 
Set wbTarget = ThisWorkbook  

' Did you enclose the worksheet name with double quotes? 
' Reference to sheet to copy from 
set shSource = wbSource.Worksheets("Sheet2") 

' Reference to sheet to copy to 
set shTarget = wbTarget.Worksheets("Sheet to copy to") 

' Copy data to first column in target sheet 
shSource.Range("C2:C10").Copy Destination:= shTarget.Cells(1,1) 

End Sub 

Таким образом, вы не должны использовать операторы, такие как Activate, которые подвержены ошибкам в некоторых ситуациях.

Answer 2

Смотрите различные способы применения призывающих листов:

Private Sub CommandButton1_Click() 

Dim wB As Workbook 
Dim wS As Worksheet 

Set wB = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") 


Set wS = wB.Sheets("SheetName") 'Name of the sheet in Excel 
''OR 
'Set wS = wB.Sheet2 'Name that you'll see in VBE in parenthesis 

wS.Range("C2:C10").Copy 

Dim wB2 As Workbook 
Dim wS2 As Worksheet 
Dim rG As Range 

'if Results.xlsm as already open 
Set wB2 = Workbooks("Results.xlsm") 
Set wS2 = wB2.Sheets("Sheet1") 
Set rG = wS2.Range("B2") 
rG.Paste 

End Sub 

Answer 3

, так как вы сказали «это должно быть сделано автоматически без открытия каждого файла.», вы можете попробовать это:

Option Explicit 

Sub main() 
    Dim fso As New FileSystemObject 
    Dim testFolder As Folder 
    Dim f As File 
    Dim i As Long 

    Set testFolder = fso.GetFolder("C:\Users\Ridwan\Desktop\Test_Excel") 
    With Worksheets("Results") 
     For Each f In testFolder.Files 
      If Left(f.Name, 4) = "Test" Then 
       If fso.GetExtensionName(f.Path) = "xlsm" Then 
        With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 
         .Value = f.Name 
         i = 0 
         Do 
          i = i + 1 
          .Offset(, i).Formula = "='" & testFolder.Path & "\[" & f.Name & "]Sheet1'!C" & i + 1 
         Loop While .Offset(, i) <> 0 
         .Offset(, i).ClearContents 
         With Range(.Offset(, 1), .Offset(, 1).End(xlToRight)) 
          .Value = .Value 
         End With 
        End With 
       End If 
      End If 
     Next f 
    End With 
End Sub 

требует «Microsoft Scripting Runtime» ссылка будет добавлен в ваш проект (Tool -> References, затем прокрутите окно списка, пока вы видите эту библиотеку, установите флажок в его влево и нажмите «ОК»)