Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
163 views
in Technique[技术] by (71.8m points)

How to use Excel VBA to activate and copy row data from multiple worksheets in multiple workbooks into another workbook's worksheet?

I have a series of workbooks, containing a series of worksheets, in which I am needing to consolidate those worksheets into one worksheet (they are all identical columns).

I have the below snippet from my combined() sub that I'm trying to use to access each file, iterate over them, get each worksheet inside, and then copy the contents of each worksheet over to the combined.xlsm file.

My problem is, I'm not quite following how I should activate the workbooks/worksheets with my code. Is my code just not going to work?

CombinedWB = "Combined.xlsm"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set FLS = FSO.GetFolder("c:path	ofiles").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

Here is the final working code (thanks to 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	ofiles").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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Your problems are caused by using the .Activate method. There is no need for that in what you are trying to do. Code created using the macro recorder is littered with .Activate calls, but they are generally a bad idea when writing code yourself.

Try something more like this:

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	ofiles").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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...