none
How to copy data from multiple sheets into one sheet and append them.? RRS feed

  • Question

  • Hi I have below piece of code, to select and copy the data from one sheet and append it to the existing one. Problem is it copies only one row every time, Can someone please let me know what's wrong with the code. 

    Private Sub CommandButton21_Click()

    p5 = "N"
    i = 1
    j = 1
    c1 = 0
    Do Until p5 = ""
        p5 = Sheet1.Cells(i, j)
        c1 = c1 + 1
        i = i + 1
        
    Loop
        
    If c1 <= 1 Then
        GoTo p3:
    End If
        

    Dim s1 As Workbook
    'Dim S1 as String
    On Error GoTo p2
    f1 = Application.GetOpenFilename
        
    If f1 <> False Then
        MsgBox f1
        Set s1 = Workbooks.Open(f1)
        s3 = "N"
        i = 2
        j = 1
        p = c1
        q = 1
                
        Do Until s3 = ""
            t1 = s1.Worksheets("sheet1").Cells(i, j).Text
            If t1 = "" Then
                s3 = ""
                GoTo p2:
            Else
                Sheet1.Cells(p, q) = s1.Worksheets("sheet1").Cells(i, j).Text
                q = q + 1
                j = j + 1
                If j >= 21 Then
                    i = i + 1
                    j = 1
                    p = p + 1
                    q = 1
                End If
            End If
        Loop
    End If



    p2:
    On Error Resume Next
    s1.Close

    p3:
    End Sub

    Tuesday, March 17, 2020 9:10 AM

All replies

  •                                                                         

    Here’s the code that gets the job done:

    Option Explicit
    Public Sub CombineDataFromAllSheets()

        Dim wksSrc As Worksheet, wksDst As Worksheet
        Dim rngSrc As Range, rngDst As Range
        Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

        'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

        'Set references up-front
        Set wksDst = ThisWorkbook.Worksheets("Import")
        lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
        lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

        'Set the initial destination range
        Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

        'Loop through all sheets
        For Each wksSrc In ThisWorkbook.Worksheets

            'Make sure we skip the "Import" destination sheet!
            If wksSrc.Name <> "Import" Then

                'Identify the last occupied row on this sheet
                lngSrcLastRow = LastOccupiedRowNum(wksSrc)

                'Store the source data then copy it to the destination range
                With wksSrc
                    Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
                    rngSrc.Copy Destination:=rngDst
                End With

                'Redefine the destination range now that new data has been added
                lngDstLastRow = LastOccupiedRowNum(wksDst)
                Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

            End If

        Next wksSrc

    End Sub

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'INPUT       : Sheet, the worksheet we'll search to find the last row
    'OUTPUT      : Long, the last occupied row
    'SPECIAL CASE: if Sheet is empty, return 1
    Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
        Dim lng As Long
        If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
            With Sheet
                lng = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlFormulas, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Row
            End With
        Else
            lng = 1
        End If
        LastOccupiedRowNum = lng
    End Function

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'INPUT       : Sheet, the worksheet we'll search to find the last column
    'OUTPUT      : Long, the last occupied column
    'SPECIAL CASE: if Sheet is empty, return 1
    Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
        Dim lng As Long
        If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
            With Sheet
                lng = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlFormulas, _
                                  SearchOrder:=xlByColumns, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Column
            End With
        Else
            lng = 1
        End If
        LastOccupiedColNum = lng
    End Function

    This will help.

    Regards.

    Tuesday, March 17, 2020 9:36 AM
  • Combine by category
    1. Open each source sheet.
    2. In your destination sheet, click the upper-left cell of the area where you want the consolidated data to appear.
    3. On the Data tab, under Tools, click Consolidate.
    4. In the Function box, click the function that you want Excel to use to consolidate the data.
    • Proposed as answer by Max-44 Tuesday, March 17, 2020 9:48 AM
    Tuesday, March 17, 2020 9:48 AM