Workbooks to tabs

[KiloHotel]

Hey guys,

Is there a macro for selecting multiple workbooks and then bring them to a new workbook in tabs?

I have about 2000+ workbooks that I am currently copying and pasting and renaming each tab and it’s a pain!

Any help is appreciated

 

[ranman256]

try this...run ImportAllWbs
but you must set the target folder in it.

[Public Sub ImportAllWbs()
getFilesInDir "c:\folder\"
End Sub


Private Sub getFilesInDir(ByVal pvDir)
Dim FSO, oFolder, oFile, oRX, vFile
Dim sTxt As String, sFile As String
Dim wbTarg As Workbook, wbSrc As Workbook
On Error GoTo errGetFiles


Set wbTarg = ActiveWorkbook
If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"


Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)


For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".xls") > 0 Then
          'import file here
      vFile = pvDir & oFile.Name
      
     Workbooks.Open vFile
     Set wbSrc = ActiveWorkbook
     wbSrc.Activate
       Sheets(1).Select
       Sheets(1).Copy Before:=wbTarg.Sheets(1)
     wbSrc.Close False
  End If
Next


endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub


errGetFiles:
If Err = 3265 Then     'catch error if NO Import table errors
  ' "no errors found"
   Resume Next
Else
  MsgBox Err.Description, , Err
End If
End Sub

 

[KiloHotel]

No, That didn't work Its something to do with the first line of that macro