Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Oct 2016
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Combine specific rows from multiple workbook in to one workbook

    I have about 10 excel files in folder and only want to take rows A B C J and combine them put them in a master file on rows E F G M. Any help would be appreciated?

    a6h6mUj.pngue62Zgh.png

    Something similar to the below forum:
    http://windowssecrets.com/forums/sho...light=workbook

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    smeghani

    The following code will prompt you to select the folder that has the files you want to transfer data from. The code will cycle through the files in that folder only and only open excel type files then transfer the columns you specified from the source files to the master at the location you indicated. The data from each workbook that is opened will be transferred and placed successively on to the master. From you pics you posted, some assumptions are made:

    Master File:
    1. Data is transferred to sheet #1 starting at line 4

    Source file:
    2. The data to be transferred in is consistently on sheet #2 staring at row 3

    The code to loop though the folder was borrowed but modified to achieve your request. Credit is given in the code.

    Note: This has not been tested due to a lack of sample data but should work just fine.

    HTH,
    Maud

    In a standard module in the master file:
    Code:
    Sub ListFiles()
    'LISTFILES AND LISTMYFILES MODIFIED FROM
    'http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder
     Dim ShellApplication As Object
     On Error GoTo errorhandler
     Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     Path = ShellApplication.self.Path
     Set ShellApplication = Nothing
     '--------------------------------------------------------------------
     'DEFAULT PATH FROM HIDDEN SHEET
     Call ListMyFiles(Path, False)
    errorhandler:
     End Sub
    
    Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    '--------------------------------------------------------------------
    'DECLARE AND SET VARIABLES
     Application.ScreenUpdating = False
        Dim wb1 As Workbook, wb2 As Workbook
        Set wb1 = ThisWorkbook
        Set MyObject = New Scripting.FileSystemObject
        Set mySource = MyObject.GetFolder(mySourcePath)
        Application.ScreenUpdating = False
    '--------------------------------------------------------------------
    'FIND XLSX FILES ONLY
        For Each myfile In mySource.Files
            s = Split(myfile.Name, ".")
            ftype = s(UBound(s))
            If UCase(ftype) = "XLSX" Or UCase(ftype) = "XLSM" Or UCase(ftype) = "XLS" Then
                Nextrow = wb1.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                If Nextrow < 4 Then Nextrow = 4
    '--------------------------------------------------------------------
    'OPEN FILE AND COPY TO MASTER
                Application.Workbooks.Open myfile
                Set wb2 = ActiveWorkbook
                Lastrow = wb2.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
                For I = 2 To Lastrow
                    wb1.Worksheets(1).Cells(Nextrow, "E") = wb2.Worksheets(2).Cells(I, "A")
                    wb1.Worksheets(1).Cells(Nextrow, "F") = wb2.Worksheets(2).Cells(I, "B")
                    wb1.Worksheets(1).Cells(Nextrow, "G") = wb2.Worksheets(2).Cells(I, "C")
                    wb1.Worksheets(1).Cells(Nextrow, "M") = wb2.Worksheets(2).Cells(I, "J")
                    Nextrow = Nextrow + 1
                Next I
            End If
            wb2.Close
        Next
    '--------------------------------------------------------------------
    'SEARCH SUBFOLDERS FOR SAME CRITERIA
        If IncludeSubfolders Then
            For Each MySubFolder In mySource.SubFolders
                Call ListMyFiles(MySubFolder.Path, True)
            Next
        End If
    Application.ScreenUpdating = True
    End Sub
    I did not use With statements for show purposes.
    Last edited by Maudibe; 2016-11-02 at 06:38.

  3. #3
    New Lounger
    Join Date
    Oct 2016
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hello,

    sorry for the late reply. Thank you again for taking the time out to help me. I will inform you if there is an error.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •