VBA to copy data from multiple workbooks into master sheet

[excel_vba_1]

Hello Everyone!

I have to copy data from 10+ workbooks and paste it into a master workbook.
All the workbooks are located in a folder on my desktop: C:\Users\xbv\Desktop\group1

All the workbooks contain a sheet named 'appendix B', I have to open each workbook, go to sheet 'appendix B’, select columns range C to F starting from row 6 to row ‘x'(the last row can vary in each workbook), cntrl+v (copy), and paste the data range into master worksheet. In the master worksheet, I paste the data in Columns A to D and continue pasting/appending the data as I copy data from more workbooks. Eventually, the master workbook has the data in columns A to D from every workbook in one sheet.

The columns range C to F and starting from row 6 always remains constant in all the sheets (appendix B ) of every workbook. Each workbook contains 7 sheets, but I am only interested in sheet ‘appendix B’

I have to repeat the same steps for 10-30 workbooks and continue pasting/appending the data into master sheet. So, I was wondering if someone could please help me to create a VBA code for this? I'm really new to VBA and would really appreciate your help!

Please let me know if you require any clarification.

Many thanks! =)

 

[Haoss]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "C:\Users\xbv\Desktop\group1\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("appendix B").Range("C6:F" & LastRow).Copy
            wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Hi mumps! this vba code is good and definitely is helping on my case as well.
But is it possible for this code to clear existing data then paste the new data?

For my case, the files will be update on daily with new data. i tried with your code, it will keep duplicate the data whenever i run the code. Appreciate and looking forward for your reply

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    wkbDest.Sheets("Master").UsedRange.ClearContents
    Dim LastRow As Long
    Const strPath As String = "C:\Users\xbv\Desktop\group1\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("appendix B").Range("C6:F" & LastRow).Copy
            wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Haoss]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    wkbDest.Sheets("Master").UsedRange.ClearContents
    Dim LastRow As Long
    Const strPath As String = "C:\Users\xbv\Desktop\group1\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("appendix B").Range("C6:F" & LastRow).Copy
            wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Hey mumps! just want to let you know that you are my hero
Thank you for sharing your knowledge with everyone in this forum!

 

[Haoss]

Hi Mumps, possible not to clear the 1st and second row? as i would like to keep that as my headline

 

[mumps]

Replace this line of code:

wkbDest.Sheets("Master").UsedRange.ClearContents

with this line:

wkbDest.Sheets("Master").UsedRange.Offset(2).ClearContents

 

[Haoss]

Thank you mumps

 

[mumps]

You are very welcome.

 

[HeinrichPaul]

Hello mumps,

I was wondering if I could use the first code for my copying, slightly changed, as well?

I have about 15 workbooks, one (more or less) per month, going back till 2018. In each workbook there is tab 'IVAT_Format' in which there are 134 shown and probably another 100 hundred hidden columns. The workbooks are in folders on the desktop sorted via years and month and are named the same except for the month/year.

I don't need most of them, but only a few, maybe 10, giving me enough data for my purpose in analysing it. I thought I could use the macro defining the columns from row one (header) till the end. Unfortunately, though the header remained the same, the columns changed over time, still being in row one.

Would it be possible to define the headers by name instead of the columns meaning running through row and once it's been found to copy all filled cells which could be 15000 per column and copy it over.

Best Regards
Matthias

 

[mumps]

If you only need about 10 workbooks, it would be much easier to handle if those workbooks could all be in the same folder. Is this possible? If so, what is the full path to that folder? What is the file extension for the 10 files (xlsx, xlsm)? It sounds like you don't want to copy all the columns but only those that have certain headers in row 1. If this is correct, do you want to always copy the same columns? What are the header names of the columns you want to copy? What is the name of the sheet to which you want to copy the columns?

 

[HeinrichPaul]

Hello,
Thank you for your response.
Yes, sure I could also copy them all in one folder if it's easier to realize. Have them on the desktop.
The full path to the folder is C:\Users\R401054\Desktop\Job\2800 X-Company\DE\combined. The file extension is xlsb.

No I don't think it's necessary to copy all the columns. If it's easier to do than I wouldn't mind also all the columns to copy. Many of them are useless as far as I see it and that's why I thought to leave them out.
The columns needed are:
- Transactiondate
- Invoicedate
- Invoicenumber
- Supplierinvoicenumber
- Vatcode
- Taxablebasiscurrency2
- Valuevatcurrency2
- Totalvaluelinecurrency2
- BusinessPartnerName
- Client_comment
- Client_comment2

Yes, for this case I would copy the columns mentioned, but that could vary due to what Is needed.
The name of the sheet could be Returns_All.

KR
Matthias