vba to extract data from multiple excel files in 1 folder

[Peter083]

Hi, can someone please help me with the following. I have a number of excel workbooks in a folder. I am trying to extract the data from Sheet 4 (10 rows maximum) in each of these files into a separate workbook. Ideally the macro will only look at workbooks that are in this folder.

Any help or suggestions would be greatly appreciated.

Peter

 

[gallen]

So you want to copy data from several files in a folder and copy them into a single workbook? All on to one sheet or a different sheet for each workbook you got data from?

If you google "Loop through all Excel files in folder" there are many answers describing to how to loop through all files, check if they are excel and open them if they are. If your folder only contains excel files then that's easier still.

Then you just need the VBA to copy the desired info and paste in to your main workbook.

How conversant are you with VBA?

 

[Peter083]

Hi Gallen

Thanks for your reply. I am below a novice when it comes to vba.

In each of the workbooks is a worksheet (Sheet 4) and I am trying to copy the data from Sheet 4 only into a separate workbook.

In the past I have had to open each workbook in the folder and copy and paste the data from Sheet 4 into a new Workbook which as you can imagine is a very tedious process. I am hoping that this can be automated with vba.

I tried to do it with Power Query but didn't get far.

Thanks again

Peter

 

[gallen]

Yes, easy enough with VBA. To clarify, you wish to:

1. open each workbook in a folder
2. Copy Sheet 4 into a NEW workbook, one workbook for each sheet 4 (What would the title of this new workbook be?)
3. Save the new workbook into the same folder.
4. Close the workbook you copied the data from.

Let me know if Im confused

 

[Peter083]

Hi Gallen

The Workbooks are all in one folder (called Intermediate). Without having to open each workbook separately, which is what I have been doing, I am hoping that the code will automatically extract the data from Sheet 4 of each Workbook (all in the Intermediate folder) and will copy the data from each of the Sheet 4,s in each existing Workbook in the Intermediate folder, into a new Workbook (it can have any name e.g. Summary) which can be in the Intermediate folder as well.

I hope that I am making sense, and thanks for your help.


Peter

 

[gallen]

Sorry, I meant the VBA would open up the workbook.

Is the data always in a set range ?

into a new Workbook (it can have any name e.g. Summary)

So each sheet's data will be copied into the new workbook called 'Summary' . Will the data from each sheet appear on just one sheet in 'Summary' or will they have a separate sheet for each workbook's data?

 

[Peter083]

Hi Gallen

The data is always in a set range from A1;A10 (I have extracted this data from other sheets using Index and Match)

The data from each sheet is to appear on just one sheet in the Summary

 

[gallen]

Copy this code and paste into the code window of the sheet you wish the data to appear.

You will need to change the Const value at the top to your directory and you may need to change which cells they get pasted to. I've just pasted to column A in the new Workbook.

Then run 'LoopThroughFiles'.
You can assign this to a button if it's going to be a regular thing

Private Const sPath As String = "H:\Personal\Test\" 'CHANGE THIS TO YOUR DIRECTORY PATH

Sub LoopThroughFiles()

Dim sFile As String 'File Name 
Dim sExt As String 'File extension you wish to open
    
    sExt = "xlsx" 'Change this if extension is different
    
    'loop through each file name and open it if the extension is correct
    sFile = Dir(sPath)
    Do Until sFile = ""
        If Right(sFile, 4) = sExt Then GetInfo sFile
        sFile = Dir
    Loop


End Sub

Private Sub GetInfo(sFile As String)

Dim wbFrom As Workbook 'workbook to copy the data from
Dim iRow As Integer 'row number of next empty row

 On Error GoTo errHandle
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Set wbFrom = Workbooks.Open(sPath & sFile)
    
    
        wbFrom.Sheets("Sheet1").Range("A1:A10").Copy 'Copy A1:A10
        iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
        Me.Range("A" & iRow).PasteSpecial xlPasteAll 'past copied cells
        wbFrom.Close (False)
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Set wbFrom = Nothing
    
Exit Sub
errHandle:
MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Peter083]

Thank you Gallen I appreciate your help.

 

[Adnan11]

Thank you Gallen I appreciate your help.

I have tried following code invalid use of ME keyword error is being faced, i have to search excel files and go to sheet 4 "Unique MSISDNs" and copy data from A1 to H2 and then Paste.

Private Const sPath As String = "C:\Users\naveed\Downloads\Buzzme-Reports-2" 'CHANGE THIS TO YOUR DIRECTORY PATH


Sub LoopThroughFiles()


Dim sFile As String 'File Name
Dim sExt As String 'File extension you wish to open

sExt = "xlsx" 'Change this if extension is different

'loop through each file name and open it if the extension is correct
sFile = Dir(sPath)
Do Until sFile = ""
If Right(sFile, 4) = sExt Then GetInfo sFile
sFile = Dir
Loop




End Sub


Private Sub GetInfo(sFile As String)


Dim wbFrom As Workbook 'workbook to copy the data from
Dim iRow As Integer 'row number of next empty row


On Error GoTo errHandle

Application.EnableEvents = False
Application.ScreenUpdating = False

Set wbFrom = Workbooks.Open(sPath & sFile)


wbFrom.Sheets("Unique MSISDNs").Range("A1:H8").Copy 'Copy A1:A10
iRow = Me.Range("A,B" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
Me.Range("ABCD" & iRow).PasteSpecial xlPasteAll 'past copied cells
wbFrom.Close (False)

Application.EnableEvents = True
Application.ScreenUpdating = True
Set wbFrom = Nothing

Exit Sub
errHandle:
MsgBox Err.Description
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub