Import data from multiple excel files
 

Happy Holidays to all...

I have a need to do the following:

123 different workbooks, each with a sheet named FORM. They all reside
on a network driver in the same folder.

The FORM worksheets are set-up the same, however, there are varying
rows of data between the sheets.

I need to copy all the data that is in Column B, and Column Q to a
"master" workbook.
The data I need begins at row 20, and will always start at row 20.

I have read many posts about simialr requests, and have found many
differnt examples, but am just not "getting" it. Any help, or pointers
are appreciated.

I have the following code, that will look in a folder, and tell me how
many SS are there and copy all the SS to one workbook, (thanks to this
usegroup), and thought I could modify it to work for what I need,
however, I am stuck...any help is appreciated. Thanks and hope
everyone has a nice holiday!!!

begin code snip:



Sub Testing()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim i As Long
Dim lr As Long
Dim lastcellinC As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn =
"\\ms024user1\DEPTGRPS\Marketing\Market\iDeals\Wor k_Folder\"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
lr = LastRow(basebook.Worksheets(1)) + 1
lastcellinC = mybook.Worksheets(1).Range("Q" &
Rows.Count).End(xlUp).Row
Set sourceRange = mybook.Worksheets(1).Range("a20:Q" &
lastcellinC)
Set destrange = basebook.Worksheets(1).Cells(lr, 1)
sourceRange.Copy destrange
basebook.Worksheets(1).Cells(lr, 1).Value = mybook.Name
mybook.Close
Next i
End If
End With
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

Import data from multiple excel files
 

Hi Arlan

Copy the range B:Q and delete the columns in between when the macro is ready
See
http://www.rondebruin.nl/copy3.htm

Use the second macro from the example you want to try (this one is working with network files)

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


"Arlan" wrote in message oups.com...
Happy Holidays to all...

I have a need to do the following:

123 different workbooks, each with a sheet named FORM. They all reside
on a network driver in the same folder.

The FORM worksheets are set-up the same, however, there are varying
rows of data between the sheets.

I need to copy all the data that is in Column B, and Column Q to a
"master" workbook.
The data I need begins at row 20, and will always start at row 20.

I have read many posts about simialr requests, and have found many
differnt examples, but am just not "getting" it. Any help, or pointers
are appreciated.

I have the following code, that will look in a folder, and tell me how
many SS are there and copy all the SS to one workbook, (thanks to this
usegroup), and thought I could modify it to work for what I need,
however, I am stuck...any help is appreciated. Thanks and hope
everyone has a nice holiday!!!

begin code snip:



Sub Testing()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim i As Long
Dim lr As Long
Dim lastcellinC As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn =
"\\ms024user1\DEPTGRPS\Marketing\Market\iDeals\Wor k_Folder\"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
lr = LastRow(basebook.Worksheets(1)) + 1
lastcellinC = mybook.Worksheets(1).Range("Q" &
Rows.Count).End(xlUp).Row
Set sourceRange = mybook.Worksheets(1).Range("a20:Q" &
lastcellinC)
Set destrange = basebook.Worksheets(1).Cells(lr, 1)
sourceRange.Copy destrange
basebook.Worksheets(1).Cells(lr, 1).Value = mybook.Name
mybook.Close
Next i
End If
End With
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