none
Help, new to VBA! Need to copy a set range of cells from hundreds of Excel files into one Excel file. RRS feed

  • Question

  • Help, please, I need to find a way to do this. I currently have hundreds of Excel files that I need to copy information from, but here's a simpler way to explain my issue:

    I have 26 Excel files (let's name them A to Z) with the same formatting, and one file named "Compiled Files"

    I need to copy the merged cell "L1:S1" from the Calculations tab/spreadsheet of files A to Z, and paste them into Sheet1 of "Compiled Files"

    I also need to copy the cells for C21 to K36 in the Calculations tab/spreadsheet of files A to Z, and paste them beside the pasted "L1:S1" values in Sheet1 of "Compiled Files".

    Thank you so much! I tried using several VBA codes on the internet but I could not get them to work. This is my 2nd day of trying it.

    Wednesday, October 10, 2018 4:37 PM

All replies

  • I am using Excel 2010.
    Wednesday, October 10, 2018 4:47 PM
  • Hi JBenitez07,

    The following is an example of copying and pasting multiple Excel files into a single Excel file. Please refer to the following code:

    Option Explicit
    Sub copy_rng()
        Dim wb As Workbook, wbDest As Workbook, ws As Worksheet, wsDest As Worksheet, wsSrc As Worksheet
        Dim wbNames() As Variant
        Dim destFirstCell As Range
        Dim destColStart As Integer, destRowStart As Long, i As Byte
        Dim destPath As String
    
        Set wb = ThisWorkbook
        Set ws = wb.Sheets("Sheet1") ' Amend to your sheet name
        Set wsSrc = wb.Sheets("Sheet2") ' Amend to sheet name with table data
        wbNames = ws.Range("A2:A" & lrow(1, ws)) ' Pass col number into lrow function
        destPath = "C:\Users\"
    
        Application.ScreenUpdating = False
        For i = 1 To UBound(wbNames, 1)
            Set wbDest = Workbooks.Open(destPath & wbNames(i, 1))
            Set wsDest = wbDest.Worksheets(1)
            With wsDest
                Set destFirstCell = .Cells.Find(What:="*")
                destColStart = destFirstCell.Column
                destRowStart = destFirstCell.Row
                .Range(Cells(destRowStart, destColStart), _
                    Cells(lrow(destColStart, wsDest), icol(destRowStart, wsDest))).Copy
            End With
            wsSrc.Cells(lrow(1, wsSrc) + 1, 1).PasteSpecial Paste:=xlPasteAll
            wbDest.Close False
        Next i
        Application.ScreenUpdating = True
    
    End Sub
    
    Function lrow(ByVal col_num As Integer, sheet_name As Worksheet) As Long
        lrow = sheet_name.Cells(Rows.Count, col_num).End(xlUp).Row
    End Function
    
    Function icol(ByVal row_num As Long, sheet_name As Worksheet) As Integer
        icol = sheet_name.Cells(row_num, Columns.Count).End(xlToLeft).Column
    End Function

    For more information, please see the following links:

    VBA - Copying and Pasting from Multiple Excel files to Single Excel File

    Copy data from multiple files into one sheet with incremental rows.

    Hopefully it helps you.

    Best Regards,

    Lina


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread.


    • Edited by Lina-MSFT Thursday, October 11, 2018 2:16 AM
    Thursday, October 11, 2018 2:14 AM
  • Thank you Lina,

    I am really new to this, would you be so kind as to paste the info I have to the appropriate code you sent?

    Workbook to paste from: A.xlsm, B.xlsm, C.xlsm

    Cells to paste from the workbooks above: L1, C21:J30 (Worksheet name: "Calculations")

    Source of workbooks:  C:\Users\benzj\Documents\Compiled

    Workbook to paste to: Compiled Files.xlsm (Woksheet name: "Sheet1")

    Source of workbook: C:\Users\benzj\Documents

    Many thanks!

    Thursday, October 11, 2018 11:31 AM
  • Hi JBenitez07,

    Please use the code as below:

    Option Explicit
    
    Sub Auto_open_change()
    
        Dim WrkBook As Workbook
        Dim StrFileName As String
        Dim FileLocnStr As String
        Dim LAARNmeWrkbk As String
        Dim rowcounter As Integer
    
        FileLocnStr = "C:\Users\benzj\Documents\Compiled" 'ThisWorkbook.Path
    
        Dim StrFile As String
        StrFile = Dir(FileLocnStr & "\*.xls")
    
        rowcounter = 1
        Do While Len(StrFile) > 0
        Call DoStuff(FileLocnStr & "\" & StrFile, rowcounter)
        StrFile = Dir
        rowcounter = rowcounter + 10
    Loop
    
    End Sub
    Private Sub DoStuff(StrFileName As String, rowcounter As Integer)
    
        Workbooks.Open (StrFileName)
    
        Call Edit(rowcounter)
    
        Workbooks.Open (StrFileName)
    
        ActiveWorkbook.Close
    
    End Sub
    
    Sub Edit(rowcounter As Integer)
    Dim Wb1 As Workbook
    Dim ws1 As Worksheet
    Dim loopcal As Long
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        lngCalc = .Calculation
     End With
    
         Set Wb1 = ActiveWorkbook
        Sheets("Calculations").Select
        Range("C21:J30").Select
        Selection.Copy
    
        Windows("Compiled Files.xlsm").Activate
        Sheets("Sheet1").Select
        Range("B" & rowcounter).Select
    
    'index the variable to ensure the cell reference changes each time.
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    End Sub
    

    Hopefully it helps you.

    Best Regards,

    Lina


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread.

    • Proposed as answer by Lina-MSFT Monday, October 29, 2018 8:19 AM
    Friday, October 12, 2018 6:48 AM
  • Hi JBenitez07,

    Thanks for your asking. Please remember to mark the replies(Include your solution) as answers if they helped and please help us close the thread.

     

    Thank you for understanding. If you have any question, or update, please feel free to let us know.

     

    I wish you a happy life!

    Best Regards,

    Lina


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread.

    Monday, October 15, 2018 4:49 AM