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\Work_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

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" <[email protected]> wrote in message news:[email protected]...
> 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\Work_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
>