consolidating multiple excel file with same header row into 1 single file

[ad3l3n3]

hi. i know there's many many post of this topic but i seriously do not understand any of it. i'm a beginnner in excel and i know nuts about vba and codings.

my scenario is as such:

i have multiple file ABC.xls, DEF.xls and GHI.xls
all three have the same headers but different datas
currently, i'm putting and pasting datas from each file into one single file.
in realiaty i have 28 files and i have to consolidate it into 1 single file each week.

would like to know how can i make my life easier?

if vba or codings are suggested, can i also know where do i paste the codings to? new file or exisiting file? do i need to put all sheets into the same folder?

 

[SydneyGeek]

Try this code. To use, open a new workbook. Press Alt+F11 to go to the code window.
Insert > Module, then paste the code
To run go to the worksheet where you want the data to end up, and press alt+F8. double-click the macro name.

You will need:
1. A folder that contains the workbooks for processing. Don't put anything else in there.
2. If you want to copy the imported files to another folder, create that folder too.
3. Near the top of the code you will see the paths for these two folders. Adjust the code to point to the correct ones.

Sub ImportWorkbooks()
   Dim FilesToProcess As Integer
   Dim i As Integer
   Dim bArchiveFiles As Boolean
   Dim sFileName As String
   Dim sOutFile As String
   Dim rwLast As Long
   Dim Sht As Worksheet
   Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit
   Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit
   Const PATH_DELIM = "\"

   'set to False if you DON'T want to move imported files to new folder
   bArchiveFiles = True

   'the FileSearch object lets you search a folder and, optionally its subfolders,
   'for files of a defined type. It loads the names of all found files into an array,
   'which we can use to import those files.
   With Application.FileSearch
     .NewSearch
     .LookIn = TOP_FOLDER
     .SearchSubFolders = False 'we only want to search the top folder
     .Filename = "*.xls" 'change this to suit your needs
     .Execute
     FilesToProcess = .FoundFiles.Count

     'check that files have been located. If not, display message and exit routine.
     If FilesToProcess = 0 Then
       MsgBox "No files found, nothing processed", vbExclamation
       Exit Sub
     End If
     
     Set Sht = ActiveSheet
     For i = 1 To FilesToProcess
       'find the last used row
       rwLast = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
       'if sheet is blank we want to import the headings as well
       If rwLast = 2 Then rwLast = 1
       'import each file, then close without saving
       Workbooks.Open .FoundFiles(i)
       If rwLast > 1 Then
            Range("A1").CurrentRegion.Offset(1, 0).Copy _
                 Destination:=Sht.Cells(rwLast, 1)
       Else
            Range("A1").CurrentRegion.Copy _
                 Destination:=Sht.Cells(rwLast, 1)
       End If
       Workbooks(.FoundFiles(i)).Close savechanges:=False
       'archive the imported files
       If bArchiveFiles Then
         'code for archiving imported files...
         sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
         sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
         sFileName = StrRev(sFileName)
         sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
           & Format(Date, "yyyymmdd") & ".csv"
         FileCopy .FoundFiles(i), sOutFile
         Kill .FoundFiles(i)
       End If
     Next i
   End With
End Sub

'The StrRev function reverses a text string. We are using it here to simplify
'extracting the file name: once the full path is reversed, we can pull out everything
'to the left of the first path delimiter. Reversing this string gives us the file name.

'Note: VBA has a StrReverse function that you can use instead of this custom function.

Function StrRev(sData As String) As String
   Dim i As Integer
   Dim sOut As String
   sOut = ""
   For i = 1 To Len(sData)
      sOut = Mid(sData, i, 1) & sOut
   Next i
   StrRev = sOut
End Function

Denis

 

[bostonflunkie]

When I tried this file I got a RTE: 445. Object doesnn't support this action.
When I debug it, it points to: With Application.FileSearch.
Can you help with this? Thanks.

 

[SydneyGeek]

Application.FileSearch no longer works in VBA -- it was effectively disabled in 2007.

You will need to use Dir to loop through the files -- I'll see if I can dig up an example.

Denis