Importing select Range from multiple workbooks
 

Hi,

Is there any way to import certain data from multiple workbooks held i
a directory and sub directories below that.

I recieve 8 workbooks every month from 8 suppliers. They are saved in
subdirectory under c:\audit. For example: supplier1 subdirectory-wit
all the audits for every month (depending on the time of year!)
January.xls, February.xls.....

The audit for each month contains:
Region, District, Store No, Score1, Score2, Score3, Score4
4, 101, 2345, 2, 4, 3, 1,
5, 206, 7298, 3, 1, 1, 4,

I want to be able to import all sites from District 101.
In other words, I click a button, (vba?) then goes into al
subdirectories of c:\audit, looks at each workbook, selects all row
that = district 101.

Can this be done?
Hopefully I have explained correctly.
Regards,
Dav

--
deejay
-----------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...fo&userid=3411
View this thread: http://www.excelforum.com/showthread.php?threadid=54097

Importing select Range from multiple workbooks
 

There should be some code on Ron de Bruin's site that will get you started:

http://www.rondebruin.nl/tips.htm

You should probably pull in all the data to your workbook and then filter
for District 101 and discard the rest.

Mike F
"deejayh" wrote in
message ...

Hi,

Is there any way to import certain data from multiple workbooks held in
a directory and sub directories below that.

I recieve 8 workbooks every month from 8 suppliers. They are saved in a
subdirectory under c:\audit. For example: supplier1 subdirectory-with
all the audits for every month (depending on the time of year!),
January.xls, February.xls.....

The audit for each month contains:
Region, District, Store No, Score1, Score2, Score3, Score4
4, 101, 2345, 2, 4, 3, 1,
5, 206, 7298, 3, 1, 1, 4,

I want to be able to import all sites from District 101.
In other words, I click a button, (vba?) then goes into all
subdirectories of c:\audit, looks at each workbook, selects all rows
that = district 101.

Can this be done?
Hopefully I have explained correctly.
Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile:
http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Thanks for the reply Mike,

Funny thing is I am using code from http://www.rondebruin.nl

But I don't know how to expand this to check a column - "District" an
to bring in data from the corresponding row?

Any help appreciated

Regards,
Dav

--
deejay
-----------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...fo&userid=3411
View this thread: http://www.excelforum.com/showthread.php?threadid=54097

Importing select Range from multiple workbooks
 

Thanks for the reply Mike,

Funny thing is I am using code from http://www.rondebruin.nl

But I don't know how to expand this to check a column - "District" and
to bring in data from the corresponding row?

I would also like for the user to select from a dropdown a "District"
and then for the code to run. If that could be possible?

Any help appreciated

Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi deejayh

I try to update the site with a filter example next week

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Thanks for the reply Mike,

Funny thing is I am using code from http://www.rondebruin.nl

But I don't know how to expand this to check a column - "District" and
to bring in data from the corresponding row?

I would also like for the user to select from a dropdown a "District"
and then for the code to run. If that could be possible?

Any help appreciated

Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

Many thanks for your help. I am visiting your site every day:)

Hopefully you will add this soon, as I have to have it completed by
next Tuesday -no pressu(

Thanks again,

All the best,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi deejayh

Ok, here is a tester for you that filter the range A1:A100 in the first sheet in each workbook (in C:\Data) for ron
and copy the complete row in the first sheet of the workbook with the code.

Try to work more on it this evening and update the site
Maybe this help you today

Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames < ""


rnum = LastRow(basebook.Worksheets(1)) + 1
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, note A1 ia the Header cell
.Range("A1:A100").AutoFilter Field:=1, Criteria1:="ron"

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If
End With
.AutoFilterMode = False
End With


mybook.Close False

FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

Many thanks for your help. I am visiting your site every day:)

Hopefully you will add this soon, as I have to have it completed by
next Tuesday -no pressu(

Thanks again,

All the best,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Oops
This is not working correct
Send a good macro one this evening


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
Hi deejayh

Ok, here is a tester for you that filter the range A1:A100 in the first sheet in each workbook (in C:\Data) for ron
and copy the complete row in the first sheet of the workbook with the code.

Try to work more on it this evening and update the site
Maybe this help you today

Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames < ""


rnum = LastRow(basebook.Worksheets(1)) + 1
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, note A1 ia the Header cell
.Range("A1:A100").AutoFilter Field:=1, Criteria1:="ron"

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If
End With
.AutoFilterMode = False
End With


mybook.Close False

FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

Many thanks for your help. I am visiting your site every day:)

Hopefully you will add this soon, as I have to have it completed by
next Tuesday -no pressu(

Thanks again,

All the best,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

This one is working

'This basic example filter the range A1:A100 on the first sheet in each workbook (in C:\Data) for ron
'and copy the complete row(s) to the first sheet of the workbook with this code.
'Note: This example use the function LastRow


Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data" '<<< Change
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames < ""

'Find the last row on the first sheet(used to copy the data below the data that exist)
rnum = LastRow(basebook.Worksheets(1)) + 1

'Open the workbook
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)
Set rng = Nothing

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, Note: A1 is the Header cell
'Change the range and criteria to your Range/Criteria
.Range("A1:A100").AutoFilter Field:=1, Criteria1:="ron"

With .AutoFilter.Range

' Set a range without the Header cell
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'If there isdata copy the rows
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If

End With

'Close AutoFilter
.AutoFilterMode = False
End With

'Close the workbook
mybook.Close False

'Go to the Next workbook in the folder
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
Oops
This is not working correct
Send a good macro one this evening


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
Hi deejayh

Ok, here is a tester for you that filter the range A1:A100 in the first sheet in each workbook (in C:\Data) for ron
and copy the complete row in the first sheet of the workbook with the code.

Try to work more on it this evening and update the site
Maybe this help you today

Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames < ""


rnum = LastRow(basebook.Worksheets(1)) + 1
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, note A1 ia the Header cell
.Range("A1:A100").AutoFilter Field:=1, Criteria1:="ron"

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If
End With
.AutoFilterMode = False
End With


mybook.Close False

FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

Many thanks for your help. I am visiting your site every day:)

Hopefully you will add this soon, as I have to have it completed by
next Tuesday -no pressu(

Thanks again,

All the best,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Thanks very much for that Ron - I appreciate it.

Couple of other questions:
1) How do I add a Combo Box and set the value within your code?
for example on the combo you could select "201" then (with your code
goes into all the directories and selects all the data in a range o
B8:B400

2) How do I get it to search in all subdirectories below c:\Data?

Also how can I set the data to go into a specific sheet?

Thanks again Ron,
Regards,
Dav

--
deejay
-----------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...fo&userid=3411
View this thread: http://www.excelforum.com/showthread.php?threadid=54097

Importing select Range from multiple workbooks
 

Do you want to use a combobox or a validation dropdown?
Do you know the values that must be in the combo?

2) you can add the filter code in the code on this page
http://www.rondebruin.nl/fso.htm

3) I show you in my reply when I have read your reply


--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Thanks very much for that Ron - I appreciate it.

Couple of other questions:
1) How do I add a Combo Box and set the value within your code?
for example on the combo you could select "201" then (with your code)
goes into all the directories and selects all the data in a range of
B8:B400

2) How do I get it to search in all subdirectories below c:\Data?

Also how can I set the data to go into a specific sheet?

Thanks again Ron,
Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

Do you want to use a combobox or a validation dropdown?

Whichever, see below
Do you know the values that must be in the combo?

I have used previously a combobox, with a list in the same workbook but
on another sheet, with 2 columns: Region, District
ie.. West, 101
The last figure"District" being the value required.
Also how can I set the data to go into a specific sheet?

Many thanks Ron,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Ok you have the combobox already so you can read the selected value

See this example that copy in a sheet named "Sheet2"
(you see it two times in the code)

And use a combobox on Sheet3 named ComboBox1
Sheets("Sheet3").ComboBox1.Value

Test this and you can add the code in the filesystemobject example on my site
http://www.rondebruin.nl/fso.htm


Sub Example13()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim str As String

SaveDriveDir = CurDir
MyPath = "C:\Data" '<<< Change
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
str = Sheets("Sheet3").ComboBox1.Value

Do While FNames < ""

'Find the last row on the first sheet (used to copy the data below the data that exist)
rnum = LastRow(basebook.Worksheets("Sheet2")) + 1

'Open the workbook
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)
Set rng = Nothing

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, Note: A1 is the Header cell
'Change the range and criteria to your Range/Criteria
.Range("A1:A100").AutoFilter Field:=1, Criteria1:=str

With .AutoFilter.Range

' Set a range without the Header cell
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'If there is data copy the rows
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets("Sheet2").Cells(rnum, "A")
End If

End With

'Close AutoFilter
.AutoFilterMode = False

End With

'Close the workbook
mybook.Close False

FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

Do you want to use a combobox or a validation dropdown?

Whichever, see below
Do you know the values that must be in the combo?

I have used previously a combobox, with a list in the same workbook but
on another sheet, with 2 columns: Region, District
ie.. West, 101
The last figure"District" being the value required.
Also how can I set the data to go into a specific sheet?

Many thanks Ron,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

Many thanks for that - but being a complete novice I cannot see how to
add the http://www.rondebruin.nl/fso.htm - FileSystemObject

I have now put the data as follows:
c:\audit
example:
c:\audit\contractors\supplier1\ddd.xls
c:\audit\contractors\supplier2\sss.xls

The range to check is B8:B400
The column is I


Code:
--------------------
Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim str As String

SaveDriveDir = CurDir
MyPath = "C:\audit\Contractor\" '<<< Change
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
str = Sheets("Code").ComboBox2.Value
Do While FNames < ""

'Find the last row on the first sheet(used to copy the data below the data that exist)
rnum = LastRow(basebook.Worksheets(1)) + 1

'Open the workbook
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)
Set rng = Nothing

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, Note: A1 is the Header cell
'Change the range and criteria to your Range/Criteria
.Range("B8:B400").AutoFilter Field:=1, Criteria1:=str '<<< Change

With .AutoFilter.Range

' Set a range without the Header cell
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'If there isdata copy the rows
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If

End With

'Close AutoFilter
.AutoFilterMode = False
End With

'Close the workbook
mybook.Close False

'Go to the Next workbook in the folder
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--------------------

Oh the other thing, in the audits (the data to be imported) I have some
comments and pictures which are being seen when you import - anyway to
turn these off also?

Many many thanks again,
Cheers,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Does anyone know how to get the data from all subdirectories of
c:\audit\contractors\ ???
Thanks
deejayh Wrote:
Hi Ron,

Many thanks for that - but being a complete novice I cannot see how to
add the http://www.rondebruin.nl/fso.htm - FileSystemObject

I have now put the data as follows:
c:\audit
example:
c:\audit\contractors\supplier1\ddd.xls
c:\audit\contractors\supplier2\sss.xls

The range to check is B8:B400
The column is I


Code:
--------------------
Sub Example1_Filter_Workbooks()
'Note: This example use the function LastRow
Dim basebook As Workbook
Dim mybook As Workbook
Dim rng As Range
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim str As String

SaveDriveDir = CurDir
MyPath = "C:\audit\Contractors\" '<<< Change
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
str = Sheets("Code").ComboBox2.Value
Do While FNames < ""

'Find the last row on the first sheet(used to copy the data below the data that exist)
rnum = LastRow(basebook.Worksheets(1)) + 1

'Open the workbook
Set mybook = Workbooks.Open(FNames)

With mybook.Sheets(1)
Set rng = Nothing

'Close AutoFilter first
.AutoFilterMode = False

'This example filter on column A for ron, Note: A1 is the Header cell
'Change the range and criteria to your Range/Criteria
.Range("B8:B400").AutoFilter Field:=1, Criteria1:=str '<<< Change

With .AutoFilter.Range

' Set a range without the Header cell
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

'If there isdata copy the rows
If Not rng Is Nothing Then
rng.EntireRow.Copy basebook.Worksheets(1).Cells(rnum, "A")
End If

End With

'Close AutoFilter
.AutoFilterMode = False
End With

'Close the workbook
mybook.Close False

'Go to the Next workbook in the folder
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

--------------------

Oh the other thing, in the audits (the data to be imported) I have
some comments and pictures which are being seen when you import -
anyway to turn these off also?

Many many thanks again,
Cheers,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

You are the man!

Thanks I will try that when I am back at work on Thursday.

Cheers Ron. :) :) :)


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

Sorry to say that this one is not working.
It will only open the first file in the first folder. Then stops with
the first .xls file open.

Thanks,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Working OK for me
Send me one of the files then I look at it

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

Sorry to say that this one is not working.
It will only open the first file in the first folder. Then stops with
the first .xls file open.

Thanks,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

Sent to your email address on your website.

Thanks again,

Best regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

Hi Ron,

That really sorted it! Well done and Thanks.

I think I may of been getting mixed up with the sheets!?
Not sure if it meant this sheet, that sheet or the sheet in the
workbook to import!

Code:
--------------------
*et basebook = ThisWorkbook
str = Sheets("Code").ComboBox2.Value

'Clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
basebook.Worksheets("import").Cells.Clear

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
rnum = LastRow(basebook.Worksheets("import")) + 1

'With mybook.Sheets(1)
With mybook.Sheets(1) 'use the first sheet in every workbook*
--------------------


I think that was the problem! Told you I was useless at this vba.

Now have to find out sorting the data then getting a chart out of it!

Onca again Ron, Many thanks,
Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973

Importing select Range from multiple workbooks
 

You are welcome

--
Regards Ron de Bruin
http://www.rondebruin.nl


"deejayh" wrote in message
...

Hi Ron,

That really sorted it! Well done and Thanks.

I think I may of been getting mixed up with the sheets!?
Not sure if it meant this sheet, that sheet or the sheet in the
workbook to import!

Code:
--------------------
*et basebook = ThisWorkbook
str = Sheets("Code").ComboBox2.Value

'Clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
basebook.Worksheets("import").Cells.Clear

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
rnum = LastRow(basebook.Worksheets("import")) + 1

'With mybook.Sheets(1)
With mybook.Sheets(1) 'use the first sheet in every workbook*
--------------------


I think that was the problem! Told you I was useless at this vba.

Now have to find out sorting the data then getting a chart out of it!

Onca again Ron, Many thanks,
Regards,
Dave


--
deejayh
------------------------------------------------------------------------
deejayh's Profile: http://www.excelforum.com/member.php...o&userid=34110
View this thread: http://www.excelforum.com/showthread...hreadid=540973