Как использовать Excel VBA для активации и копирования данных строк из нескольких листов в нескольких книгах в рабочий лист рабочей книги?

У меня есть серия книг, содержащих ряд рабочих листов, в которых мне нужно объединить эти рабочие листы в один рабочий лист (все они одинаковые столбцы).

У меня есть приведенный ниже фрагмент из моего комбинированного () элемента, который я пытаюсь использовать для доступа к каждому файлу, итерации по ним, получения каждого рабочего листа внутри, а затем копирования содержимого каждого листа в файл объединенный.xlsm.

Моя проблема в том, что я не совсем понимаю, как я должен активировать книги / рабочие листы с помощью моего кода. Мой код просто не работает?

CombinedWB = "Combined.xlsm" Set FSO = CreateObject("Scripting.FileSystemObject") Set FLS = FSO.GetFolder("c:\path\to\files").Files Row = 1 For Each F In FLS CurrentWB = F.Name Windows(CurrentWB).Activate If CurrentWB <> CombinedWB Then On Error Resume Next Application.DisplayAlerts = False Worksheets("Combined").Delete Application.DisplayAlerts = True If Row = 1 Then Windows(CombinedWB).Activate For Each Cell In ActiveSheet.Range("A3") Worksheets("Combined").Range("A" & Row).Value = "Name" Worksheets("Combined").Range("B" & Row).Value = "Player" Worksheets("Combined").Range("C" & Row).Value = Cell.Value Worksheets("Combined").Range("D" & Row).Value = Cell.Offset(0, 1).Value Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value Next Windows(CurrentWB).Activate Row = 2 End If For J = 1 To Sheets.Count Player = Sheets(J).Cells(1).Parent.Name Injury = Sheets(J).Range("A5").Value InjuryDate = Sheets(J).Range("B5").Value For Each Cell In Sheets(J).Range("A5:A100") Windows(CombinedWB).Activate If IsEmpty(Cell.Offset(0, 2).Value) <> True Then Worksheets("Combined").Range("A" & Row).Value = Name Worksheets("Combined").Range("B" & Row).Value = Player Worksheets("Combined").Range("C" & Row).Value = Injury Worksheets("Combined").Range("D" & Row).Value = InjuryDate Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value Row = Row + 1 End If Next Next End If Next 

РЕДАКТИРОВАТЬ

Вот окончательный рабочий код (благодаря mwolfe02):

 Sub Combine() Dim J As Integer Dim Sport As String Dim Player As String Dim Injury As String Dim InjuryDate As String Dim Row As Integer Dim FSO As Object Dim FLS As Object Dim CurrentWB As String Dim CombinedWB As String Dim CombinedWBTemp As String Dim wb As Workbook Dim cwb As Workbook Dim ws As Worksheet Dim cws As Worksheet CombinedWB = "Combined.xlsm" CombinedWBTemp = "~$" & CombinedWB Set FSO = CreateObject("Scripting.FileSystemObject") Set FLS = FSO.GetFolder("c:\path\to\files").Files Set cwb = Workbooks(CombinedWB) Set cws = cwb.Worksheets("Combined") cws.Range("A1:Z3200").Clear Row = 1 For Each F In FLS CurrentWB = F.Name If CurrentWB <> CombinedWB And CurrentWB <> CombinedWBTemp Then On Error Resume Next Set wb = Workbooks.Open(CurrentWB) On Error Resume Next If Not wb.Sheets("Combined") Is Nothing Then Application.DisplayAlerts = False wb.Sheets("Combined").Delete Application.DisplayAlerts = True End If If Row = 1 Then For Each Cell In wb.Sheets(1).Range("A3") cws.Range("A" & Row).Value = "Sport" cws.Range("B" & Row).Value = "Player" cws.Range("C" & Row).Value = Cell.Value cws.Range("D" & Row).Value = Cell.Offset(0, 1).Value cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value Next Row = 2 End If For Each ws In wb.Worksheets Player = ws.Cells(1).Parent.Name Injury = ws.Range("A5").Value InjuryDate = ws.Range("B5").Value For Each Cell In ws.Range("A5:A100") If IsEmpty(Cell.Offset(0, 2).Value) <> True Then cws.Range("A" & Row).Value = wb.Name cws.Range("B" & Row).Value = Player cws.Range("C" & Row).Value = Injury cws.Range("D" & Row).Value = InjuryDate cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value Row = Row + 1 End If Next Next wb.Close SaveChanges:=True End If Next Windows(CombinedWB).Activate Sheets("Combined").Activate End Sub 

    Ваши проблемы вызваны использованием метода .Activate . Нет необходимости в этом в том, что вы пытаетесь сделать. Код, созданный с помощью .Activate , .Activate , но они, как правило, являются плохой идеей при написании кода самостоятельно.

    Попробуйте что-нибудь еще:

     Const CombinedWB As String = "Combined.xlsm" Dim FSO As Object, FLS As Object, F As Object Dim wb As Workbook, ws As Worksheet Dim cwb As Workbook 'This will be our combined workbook' Dim cws As Worksheet 'This will be the combined worksheet' Set FSO = CreateObject("Scripting.FileSystemObject") Set FLS = FSO.GetFolder("c:\path\to\files").Files Set cwb = Workbooks.Open(CombinedWB) 'Use the following line if there is just a single combined worksheet' ' and it is in the combined workbook' Set cws = cwb.Worksheets("Combined") For Each F In FLS Set wb = Workbooks.Open(F.Name) If F.Name <> CombinedWB Then .... 'Use the following line if each workbook has a combined worksheet' Set cws = wb.Worksheets("Combined") For Each ws In wb.Worksheets cws.Range("A1") = cws.Range("A1") + ws.Range("A1") .... Next ws End If wb.Close SaveChanges:=True Next F 
    Давайте будем гением компьютера.