HELP => VBA Code To Import Worksheets Into A WorkBook

[tommo_blade]

Hello,
does anyone have any snippets/examples of code that will help
me do the following:-

I have a directory that will contain 'n' number of excel workbooks
that have been emailed to me, there is a **single worksheet within
this workbook and it will contain data, cell functions and macro's, I
am going to put a button on my master workbook and I want that to
import all workbooks from this directory and have them inserted as a
seperate worksheet within my master workbook keeping all the original
imported worksheet data, functions & macro's intact.

** I may need to test that the imported worksheet only has the ONE
worksheet, anymore and I need to know about it...

any help/guidance is appreciated...


thanks in advance, Mark.

 

[Joel]

Sub InportSheets()

Folder = "c:\temp\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
With ThisWorkbook
Set bk = Workbooks.Open(Filename:=Folder & FName)
If bk.Sheets.Count > 1 Then
MsgBox ("More Then one sheet in " & FName)
End If
Worksheets.Copy after:=.Sheets(.Sheets.Count)
bk.Close savechanges:=False
End With

FName = Dir()
Loop

End Sub

 

[tommo_blade]

It does'nt seem to like the line identified by ==> LINE <== below:

Sub import_xls()
MsgBox "Hello:"
Folder = "F:\My Documents\Fantasy Football\XLS_Emails\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
With ThisWorkbook
==> Set bk = Workbooks.Open(Filename:=Folder & FName) <==
If bk.Sheets.Count > 1 Then
MsgBox ("More Then one sheet in " & FName)
End If
Worksheets.Copy after:=.Sheets(.Sheets.Count)
bk.Close savechanges:=False
End With


FName = Dir()
Loop


End Sub

 

[Joel]

I tried running your modified code and it is working fine. Try the following

1) Try opening the files manually in excel and see if it opens. You may not
have permission to open the file or the file is corrupted. Maybe an excel
file created in a different version of excel.
2) Put some excel files on your c: drive and try again to verify the code
runs on your PC.

This code is pretty generic and shold not have problems. The folder exists
because you would of gotten an error on the line with DIR.

 

[tommo_blade]

my error, I had copied the same xls file into the directory that I was
using as the master, put a completely different xls in that dir and it
works fine...

many thanks..

 

[tommo_blade]

the code does not appear to be doing exactly what I wanted, here was
my criteria:-

I have an open workbook and I execute a macro from one of the
worksheets within that book, I want the macro to look in a directory
and search for valid .xls files, I then need it to look thr every
workbook looking for a certain type of worksheet, so far the code does
this ok (except that it physically open each workbook, can it do this
in the background), when such a sheet is found I want the sheet
copying (macro, functions & all) as a new sheet in my open workbook -
this the code is not doing.

-------------------------------------------------------------------------------------------------------------
Sub import_xls()
Dim y As Integer
Dim d As Integer
Dim p As Integer

Folder = "F:\My Documents\Fantasy Football\XLS_Emails\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
With ThisWorkbook
Set bk = Workbooks.Open(Filename:=Folder & FName)
For y = 1 To bk.Sheets.Count
If Left(bk.Sheets(y).Cells(1, 1), 4) = "Name" Then
MsgBox "FOUND A VALID TEAMSHEET " & bk.Sheets(y).Cells(1, 2) &
" IN:" & FName
For p = 8 To 18
If InStr(1, bk.Sheets(y).Cells(p, 2), 1) <> "" Then
MsgBox "PLAYER CELL POPULATED OK: " & p
Else
MsgBox "ERROR: EMPTY PLAYER CELL IN: " &
bk.Sheets(y).Cells(p, 2)
Exit Sub
End If
Next p

Else
'MsgBox "UN-MATCHED TEAMSHEET:" & FName
End If

MsgBox "CREATING NEW WORKSHEET FOR:" & bk.Sheets(y).Cells(1,
2)
Worksheets.Copy after:=Sheets(Sheets.Count)
bk.Close savechanges:=False

Next y
End With


FName = Dir()
Loop
End Sub

 

[Keith]

worksheets.copy needs to have an index value, like worksheets(y).copy

each workbook needs to be opened. To hide this, put this near the top of
your routine, resetting it to true at the end of your routine.

Application.ScreenUpdating = False

hth
Keith

 

[tommo_blade]

it's this piece of code that I do not understand:

Worksheets.Copy after:=Sheets(Sheets.Count)
bk.Close savechanges:=False

at the top of my code I have set the following, this sets bk to be the
workbook I have opened:

Folder = "F:\My Documents\Fantasy Football\XLS_Emails\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
With ThisWorkbook
Set bk = Workbooks.Open(Filename:=Folder & FName)
For y = 1 To bk.Sheets.Count

< more code >


so how does the copy work, what is copying what to where - I want to
copy the sheet from the open workbook to a new sheet in my master
workbook

Worksheets.Copy after:=Sheets(Sheets.Count)
bk.Close savechanges:=False


sorry for being dumb..