Loop through folder and copy worksheet

[shoneh]

Hi all, me again!

Todays task for me is to try and open a folder which contains loads of various excel files, then open each file and copy the contents of sheet 1 exculding the headers (and offset function??).

Once It has copied the data then to paste it into a "master file" but to find the next free row and paste the data. I have had a look on the internet and found this code which does a great job of opening every single workbook in the file path. But Im stuck on how to select the data contained with in sheet 1 and copy the cells, stupid i know...

(Armed with my new VBA book I would like to crack this by the end of the day) :D
Public objFSO As Object
Sub GetContentsOfA1()

Dim aFileArray() As String
Dim x As Long, y As Long
Dim wrkBk As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
ReadDriveContents aFileArray, "H:\Macro\2013-07"
Set objFSO = Nothing

y = 1
For x = LBound(aFileArray) To UBound(aFileArray)
Set wrkBk = Workbooks.Open(aFileArray(x))
ThisWorkbook.Worksheets("Sheet1").Cells(y, 1).Value = wrkBk.Worksheets(1).Cells(1, 1)
wrkBk.Close SaveChanges:=False
y = y + 1
Next x

End Sub
Sub ReadDriveContents(ByRef aFileArray, ByVal DrivePath)
'// Returns an Array with All files and Folders
Dim objFolder As Object
Dim objFile As Variant
Dim colFiles As Variant
Dim i: i = 0

'// Read Parent Folder
Set objFolder = objFSO.Getfolder(DrivePath)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If objFile Like "*.xls" Or _
objFile Like "*.xlsx" Or _
objFile Like "*.xlsm" Then
ReDim Preserve aFileArray(i)
aFileArray(UBound(aFileArray)) = objFile
i = i + 1
End If
Next
End Sub

 

[bertie]

The code you supplied uses File Scripting Object. Personally I prefer to use functions native to Excel when manipulating files. See if this works for you.

The code is heavily commented.
To test:
Open a new workbook.
Press Alt+F11 to open the vba editor.
Click Insert => Module.
Copy and paste the code.

Press F8 to step through the code one line at a time. You will need to edit the code to suit your needs, i.e., folder path

Sub ImportExcelfiles()
   Dim strPath As String
   Dim strFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   
   Dim rowCountSource As Long
   Dim colCountSource As Long
   Dim rowOutputTarget As Long
   
   '============================
   'EDiT THE PATH To THE FOLDER
   '============================
   strPath = "C:\temp\MrExcel\ExcelFiles\"   'REMEMBER END BACKSLASH
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
   'set the target worksheet
   Set wsTarget = ThisWorkbook.Worksheets(1)
   
   'set the initial output row
   rowOutputTarget = 2
   
   'get the first file
   strFile = Dir(strPath & "*.xls*")
   
   'loop throught the excel files in the folder
   Do Until strFile = ""
      
      'don't process the workbook containing this macro
      If strFile <> ThisWorkbook.Name Then
      
         'open the workbook
         Set wbSource = Workbooks.Open(strPath & strFile)
         Set wsSource = wbSource.Worksheets(1)
         
         'get the row and column counts
         With wsSource
            'row count based on column 1 = A
            rowCountSource = .Cells(.Rows.Count, 1).End(xlUp).Row
            
            'column count based on row 1
            colCountSource = .Cells(1, .Columns.Count).End(xlToLeft).Column
         End With
      
         'copy and paste from A2
         wsSource.Range(Cells(2, 1), Cells(rowCountSource, colCountSource)).Copy
         wsTarget.Range("A" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
      
         'update output row
         rowOutputTarget = rowOutputTarget + rowCountSource - 1
         
         'close the opened workbook
         wbSource.Close SaveChanges:=False
      End If
      'get the next file
      strFile = Dir()
   Loop
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub

Any problems/questions feel free to ask.
Bertie

 

[shoneh]

Bertie,

You are a true Saint! I can't thankyou enough.

I am having one slight problem and that is when I'm going through the code using f8 i get unstuck at this point:
wsSource.Range(Cells(2, 1), Cells(rowCountSource, colCountSource)).Copy

I then have to go into the excel file it has opened and manually select the correct sheet then it carrys on until the next file is open. Would it just be a case of setting it to

ws.Source.Worksheet(1).Select.........

or would one have to change this part?

Set wsSource = wbSource.Worksheets(1)

Thanks once again and in advance!! :D

The code you supplied uses File Scripting Object. Personally I prefer to use functions native to Excel when manipulating files. See if this works for you.

The code is heavily commented.
To test:
Open a new workbook.
Press Alt+F11 to open the vba editor.
Click Insert => Module.
Copy and paste the code.

Press F8 to step through the code one line at a time. You will need to edit the code to suit your needs, i.e., folder path

Sub ImportExcelfiles()
   Dim strPath As String
   Dim strFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   
   Dim rowCountSource As Long
   Dim colCountSource As Long
   Dim rowOutputTarget As Long
   
   '============================
   'EDiT THE PATH To THE FOLDER
   '============================
   strPath = "C:\temp\MrExcel\ExcelFiles\"   'REMEMBER END BACKSLASH
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
   'set the target worksheet
   Set wsTarget = ThisWorkbook.Worksheets(1)
   
   'set the initial output row
   rowOutputTarget = 2
   
   'get the first file
   strFile = Dir(strPath & "*.xls*")
   
   'loop throught the excel files in the folder
   Do Until strFile = ""
      
      'don't process the workbook containing this macro
      If strFile <> ThisWorkbook.Name Then
      
         'open the workbook
         Set wbSource = Workbooks.Open(strPath & strFile)
         Set wsSource = wbSource.Worksheets(1)
         
         'get the row and column counts
         With wsSource
            'row count based on column 1 = A
            rowCountSource = .Cells(.Rows.Count, 1).End(xlUp).Row
            
            'column count based on row 1
            colCountSource = .Cells(1, .Columns.Count).End(xlToLeft).Column
         End With
      
         'copy and paste from A2
         wsSource.Range(Cells(2, 1), Cells(rowCountSource, colCountSource)).Copy
         wsTarget.Range("A" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
      
         'update output row
         rowOutputTarget = rowOutputTarget + rowCountSource - 1
         
         'close the opened workbook
         wbSource.Close SaveChanges:=False
      End If
      'get the next file
      strFile = Dir()
   Loop
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub

Any problems/questions feel free to ask.
Bertie

 

[bertie]

Och, not again. Every time I write something like this I make the same mistake.
Change:

         'copy and paste from A2
         wsSource.Range(Cells(2, 1), Cells(rowCountSource, colCountSource)).Copy

to:

         'copy and paste from A2
         wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(rowCountSource, colCountSource)).Copy

After going to the trouble to be specific about which sheets we are working with, I always seem to make this mistake.
Silly cookie, Bertie.

 

[shoneh]

Works like a treat! thanks once again! At least i now know how it's done i can take that and play with it..

Och, not again. Every time I write something like this I make the same mistake.
Change:

         'copy and paste from A2
         wsSource.Range(Cells(2, 1), Cells(rowCountSource, colCountSource)).Copy

to:

         'copy and paste from A2
         wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(rowCountSource, colCountSource)).Copy

After going to the trouble to be specific about which sheets we are working with, I always seem to make this mistake.
Silly cookie, Bertie.

 

[bigwig88]

Hey guys,

Thanks very much for the above code. I was wondering if someone could help me made a few modifications:
1 - To Copy the entire worksheet
2 - to paste it into the masterbook, but onto a new worksheet for every excel file in the folder.

Thanks in advance!

 

[bertie]

Hi, and welcome to the forum.

For future reference it is best to start a new thread than to reopen an old one. You can provide a link to the old thread to give members a starting point. Or if you see a contribution you feel could help with your problem a PM with a link and a polite request to have a wee look sometimes works.

Anyway, to your problem.
Press Alt + F11 to open the vba editor window.
Click on the ThisWorkbook module in the Project Window on the left hand side.
Copy and paste the code below.
Edit where highlighted.

Option Explicit


Sub test()
   Dim sFolder As String
   Dim sFile As String
   Dim wbSource As Workbook
   Dim wbMaster As Workbook
   
   '====================================================
   'EDIT THIS
   sFolder = "C:\temp\"    'remember trailing backslash
   '====================================================
   
   'set up the master workbook
   Set wbMaster = ThisWorkbook
   
   On Error GoTo errHandler   'reset application setting on error
   Application.ScreenUpdating = False
   
   'loop through all excel files in folder
   sFile = Dir(sFolder & "*.xls*")
   Do Until sFile = ""
   
      'open the source workbook
      If sFile <> wbMaster.Name Then   'don't process the master workbook
         Set wbSource = Workbooks.Open(sFolder & sFile)
         
         'copy the first worksheet EDIT IF NECESSARY
         wbSource.Worksheets(1).Copy After:=wbMaster.Sheets(wbMaster.Sheets.Count)
         
         wbSource.Close SaveChanges:=False
         Application.CutCopyMode = False
      End If
      
      'get the next file
      sFile = Dir()
   Loop
   
   'tidy up
   Set wbSource = Nothing
   Set wbMaster = Nothing
   
errHandler:
   Application.ScreenUpdating = True
End Sub

Hope this helps,
Bertie