VBA to import all sheet

Topic

New Reply

Hi ,

I am novice in VBA.. Need help on below below code.

This code import only one sheet, How to tweak the code to import multiple sheet?

Code:

Sub Macro()Dim sImportFile As String, sFile As String
    Dim sThisBk                    As Workbook
    Dim vfilename                  As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set sThisBk = ActiveWorkbook
    sImportFile = Application.GetOpenFilename( _
                  fileFilter:=”Microsoft Excel Workbooks, *.xls; *.xml; *.xlsx”, Title:=”Open Workbook”)
    If sImportFile = “False” Then
        MsgBox “No File Selected!”
        Exit Sub


    Else
        vfilename = Split(sImportFile, “”)
        sFile = vfilename(UBound(vfilename))
        With Application.Workbooks.Open(Filename:=sImportFile).Sheets(1)
                 .Copy After:=sThisBk.Sheets(“Master File”)
            .Parent.Close savechanges:=False
        End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End If
End Sub

Reply | Quote

Replies

Shiva,

Welcome to the Lounge as a new poster! :cheers:

This should do the trick:

Code:

Option Explicit

Sub ImportSheets()

    Dim sImportFile As String
    Dim wkbImport   As Workbook
    Dim wkbThisBk   As Workbook
    Dim vFilename   As Variant
    Dim iFileCntr   As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wkbThisBk = ActiveWorkbook
    vFilename = Application.GetOpenFilename( _
                  FileFilter:="Microsoft Excel Workbooks, *.xls; *.xml; *.xlsx", Title:="Open Workbooks", _
                  MultiSelect:=True)
                  
    If vFilename = "False" Then
        MsgBox "No File Selected!"
        Exit Sub

    Else
        For iFileCntr = 1 To UBound(vFilename)
           Set wkbImport = Application.Workbooks.Open(Filename:=vFilename(iFileCntr))
           With wkbImport
               .Sheets(1).Copy After:=wkbThisBk.Sheets("MasterFile")
               .Close savechanges:=False
           End With
        Next iFileCntr
        
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub   'ImportSheets()

Note: You need to use the Ctrl key to Multi Select random files in the dialog box or to select a series click on the first one them hold Shift & click on the last one.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG

Your code allows import from multiple files.
Shiva asked

This code import only one sheet, How to tweak the code to import multiple sheet?

..I thinks that means more than one sheet from the same file???
IF(myMistake) THEN GoTo Sorry

zeddy

Reply | Quote

Below code works I guess, but it does not identify xml formate. I need to import tabs and selection can be any type of excel file.

Code:

[CODE]Private Sub Command9_Click()
   ‘ Requires reference to Microsoft Office 11.0 Object Library.
   Dim fDialog As FileDialog
   Dim varFile As Variant

   ‘ Clear listbox contents.
   ‘Me.FileList.RowSource = “”

   ‘ Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

   With fDialog

      .AllowMultiSelect = False
      .Filters.Add “Excel File”, “*.xls”
      .Filters.Add “Excel File”, “*.xlsx”

      If .Show = True Then

         ‘Loop through each file selected and add it to our list box.
         For Each varFile In .SelectedItems
         ‘ Label3.Caption = varFile

         Const acImport = 0
         Const acSpreadsheetTypeExcel9 = 8

         ”This gets the sheets to new tables
         GetSheets varFile

         Next
         MsgBox (“Import data successful!”)
         End If
End With
End Sub


Sub GetSheets(strFileName)
   ‘Requires reference to the Microsoft Excel x.x Object Library

   Dim objXL As New Excel.Application
   Dim wkb As Excel.Workbook
   Dim wks As Object

   ‘objXL.Visible = True

   Set wkb = objXL.Workbooks.Open(strFileName)

   For Each wks In wkb.Worksheets
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            wks.Name, strFileName, True, wks.Name & “$”
   Next

   ‘Tidy up
   wkb.Close
   Set wkb = Nothing
   objXL.Quit
   Set objXL = Nothing

End Sub

[/CODE]

Reply | Quote

Yes.. Sorry for confusion. I need to import multiple sheet from same file.

Please advise.

Thanks,
Shiva

Reply | Quote

Shiva,

Gee, and I was so proud of my self…:lol:

Ok, here’s the next question…Do you want to import ALL sheets or only SELECTED sheets? :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi Shiva
..modify the .Filters.Add to just one only as in:

Code:

.AllowMultiSelect = False
.Filters.Add "Excel File", "*.xls*"

If .Show = True Then

RG: Post#1 title is “VBA to import all sheet”

do I have to start my eye jokes again?

zeddy

Reply | Quote

Zeddy,

No..No PLEASEEEEEEEE not THAT!

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

OK, a bit of Shakespeare then as punishment:

=OR(B2, NOT(B2))

zeddy

Reply | Quote

To get us back on course…

Hopefully this bit of code will do what the OP actually wanted.

Code:

Option Explicit

Sub ImportSheets()

    Dim sImportFile As String
    Dim wkbImport   As Workbook
    Dim wkbThisBk   As Workbook
    Dim sht         As Worksheet
    Dim vFilename   As Variant
    Dim zFilter     As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wkbThisBk = ActiveWorkbook
    zFilter = "Microsoft Excel Workbooks, *.xls; *.xml; *.xlsx"
    vFilename = Application.GetOpenFilename( _
                  FileFilter:=zFilter, Title:="Open Workbooks", _
                  MultiSelect:=False)
                  
    If vFilename = "False" Then
    
        MsgBox "No File Selected!"
        Exit Sub

    Else
      Set wkbImport = Application.Workbooks.Open(Filename:=vFilename)
           
      For Each sht In wkbImport.Sheets
         sht.Copy After:=wkbThisBk.Sheets("MasterFile")
      Next sht
           
      wkbImport.Close SaveChanges:=False
     
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub   'ImportSheets()

Note: I moved the file filter to a variable to make it easier to modify w/o messing with the rest of the file open code.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG

Back on track now.
What about *.xlsb files in the file filter then??

zeddy

Reply | Quote

Zeddy,

Now you’re the one needing the specs. Did you not see the Note:? 😆 After all we need to leave something for the posters to do. :evilgrin:

For those who may be interested I decided to merge what I thought was being asked and what was actually being asked into one routine and found some interesting things along the way. Here’s the code to merge all sheets from multiple workbooks.

Code:

Sub ImportSheets()

    Dim wkbImport   As Workbook
    Dim wkbThisBk   As Workbook
    Dim sht         As Worksheet
    Dim vFilename   As Variant
    Dim iFileCntr   As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wkbThisBk = ActiveWorkbook
    vFilename = Application.GetOpenFilename( _
                  FileFilter:="Microsoft Excel Workbooks, *.xls; *.xml; *.xlsx", Title:="Open Workbooks", _
                  MultiSelect:=True)
                  
Debug.Print VarType(vFilename)
                  
    If VarType(vFilename) = 8204 Then  '*** Array (8192) + Variant Array (12)! ***

        For iFileCntr = 1 To UBound(vFilename)
           Set wkbImport = Application.Workbooks.Open(Filename:=vFilename(iFileCntr))
           For Each sht In wkbImport.Sheets
              sht.Copy After:=wkbThisBk.Sheets("MasterFile")
           Next sht
           
           wkbImport.Close savechanges:=False
           
        Next iFileCntr
    
    Else
    
      MsgBox "No File Selected!"
      Exit Sub
        
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub   'ImportSheets()

When using MultiSelect=True the GetOpenFilename function will return either a String, if Cancel is pressed, or an Variant Array, if 1 or more filenames are selected. Thus, to deterine what selection the user selected you can’t do it with a straight test! You must test the TypeOf variant. In this case the test VarType(variant name) = 8204
You use 8204 because, Array (8192) + Variant Array (12)!

From MS documentation on the TypeOf() function:
Value Variant type
0 Empty (unitialized)
1 Null (no valid data)
2 Integer
3 Long Integer
4 Single
5 Double
6 Currency
7 Date
8 String
9 Object
10 Error value
11 Boolean
12 Variant (only used with arrays of variants)
13 Data access object
14 Decimal value
17 Byte
36 User Defined Type
8192 Array

Of course, this still leaves the question of…what if I want to select only some sheets? But, that’s for another day!

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG

Now you’re the one needing the specs

..we had a solar eclipse over here last month, and I stupidly looked at it through a colander.
I think I strained my eyes.

I liked your explanation and use of Arrays.
It was Array(“of”, “sunshine”)

zeddy

Reply | Quote

Based on the original post, why not simply

Sub SelectFileGetAllSheetsSAS()
Dim ds As String
Dim fNameAndPath As Variant
ds = ThisWorkbook.Name
fNameAndPath = Application.GetOpenFilename(FileFilter:= _
“Excel Files (*.XLS), *.XLS”, Title:=”Select File To Open”)
If fNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fNameAndPath
Sheets.Copy after:=Workbooks(ds).Sheets(“Master File”)
End Sub

Reply | Quote

Don,

Thanks, I didn’t realize you could use the Sheets as an aggregate. I’ll tuck that one away for future use. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Us old folks ( I had my 79th birthday on income tax day) learn something new every day.

Reply | Quote

Hi Don

Your code only allows display and select of .xls files, so seems to assume Excel2003.

From post#1 we can tell Shiva is using Excel2007 or later.
From post#5 we can tell Shiva wants

selection can be any type of excel file.

The following code will allow selection of any Excel file:
Excel file formats include:
.xlsx
.xlsm
.xlsb
.xltx
.xltm
.xls
.xlt

If the chosen source file is already open, it will close it first.
The chosen file is also opened in Read Only mode (in case another User has it open)
The chosen file will be closed after the sheet import process.

Code:

Sub importAllSheets()

'Display file select dialog to choose Excel file..
zFetch = Application.GetOpenFilename( _
        FileFilter:="All Excel Files (*.xl*), *.xl*", _
        Title:="Select Excel file for import..", _
        MultiSelect:=False)

'Check if User cancelled; no file selected..
If zFetch = False Then Exit Sub

'filename of chosen file (without path)..
zFile = Dir(zFetch)

'Cannot open workbook if already open, so..
'close file first..
On Error Resume Next    'skip error if NOT open..
'close file if already open..
Workbooks(zFile).Close SaveChanges:=False

On Error GoTo 0         'reset error trap

'open workbook in readonly mode
'(in case another User has it open)..
Workbooks.Open Filename:=zFetch, ReadOnly:=True

Set zSource = Workbooks(zFile)  'file to import FROM
Set zDest = ThisWorkbook        'file to import TO

'import all source sheets after specified sheet..
zSource.Sheets.Copy After:=zDest.Sheets("Master File")

'Close the source file after importing sheets..
zSource.Close SaveChanges:=False    'close file

End Sub

I have attached a file with this code.

zeddy

Reply | Quote

You want simple. I’ll give you simple….

Sub SelectFileGetAllSheetsSAS1()
Workbooks.Open Filename:= _
Application.GetOpenFilename(Title:=”Select File”)
Sheets.Copy after:=Workbooks(ThisWorkbook.Name).Sheets(“Master File”)
End Sub

Reply | Quote

Hi Don

That’s a cracker! Top marks!
First of all, let me say I think it’s brilliant to have such an experienced poster helping us all out here.

Now, if you believe all our cells get replaced over a 7-year cycle, then technically you are only a 7-year old with more than 70 years experience. And experience counts for a lot in my book.

I guess we are now both going to get into trouble from RG about not using any Dim statements in our last posts.
(He used 6 in his post#10).
I say..
ReDim HisRights

zeddy

Reply | Quote

Zeddy, Thanks for the kind words. And, unless I forget (can be forgiven at my age), I always use dims. My last post doesn’t call for one. Option explicit at the top of my module (which I normally include in my posts). As you can tell, I generally try to use the “keep it simple for the AGGIES” (i am a University of Texas grad where we had a rival called Texas A & M that we ridiculed for being stupid) ie: How many aggies to change a light bulb, etc

Reply | Quote

Thanks guys. I really appreciate the idea and tips you guys share.

Zeddy, your file works, but it is still not pulling xml type file. Please advise.

Reply | Quote

Shiva,

Could you post one of your xml files for us to test? :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Shiva,

Just change your filter to: [noparse]”Microsoft Excel Workbooks, *.xls*; *.xml”[/noparse]
40439-filterxml

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi Shiva

..the attached file will also allow selection of *.xlt and *.xlt files.
.. just change your filter to: “Microsoft Excel Workbooks, *.xl*; *.xml”

(The xml files are assumed to be Excel2003 .xml files)

zeddy

RG: you beat me to it again

Reply | Quote

If we are to assume that all files are xl or the user know what excel file he wants, the filters are not necessary and my 2 liner works just fine.

Sub SelectFileGetAllSheetsSAS1()
Workbooks.Open Filename:=Application.GetOpenFilename(Title:=”Select File”)
Sheets.Copy after:=Workbooks(ThisWorkbook.Name).Sheets(“Master File”)
End Sub

Reply | Quote

Hi Don

Your method got top marks from me. Short and sweet, very effective, and works perfectly well for Users who know what they are doing.

zeddy

Reply | Quote

Thanks a lot.. You guys are the pro….

Reply | Quote

Thanks a lot.. You guys are the best.. I really appreciate the efforts here.

Reply | Quote