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

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

0 голосов
/ 10 марта 2011

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

У меня есть фрагмент кода из моего комбинированного подпункта (), который я пытаюсь использовать для доступа к каждому файлу, итерации по ним, получения каждого рабочего листа внутри, а затем скопировать содержимое каждого рабочего листа в комбинированный файл .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

EDIT

Вот окончательный рабочий код (спасибо 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

1 Ответ

1 голос
/ 10 марта 2011

Ваши проблемы вызваны использованием метода .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
...