Search within range for first populated cell and copy to new workbook

[1ceman]

Hi all,

I have been working on my current project for a week or so now and am
learning vba as I go along. I have received lots of help and advice
from other forums but have now hit a major hurdle.

I am running a looped search and retrieve data module over hundreds of
files running over a five year period which basically extracts data
from the files that have predefined criteria ie cell specific, and
pastes the data into a new workbook to create a more user friendly
order history in one place rather than go through each file
individually every time.
The files that the data is extracted from are common, ie a template,
and the same cells are populated throughout.
However, on closer inspection, in one area, sometimes the data is not
in the correct position. Secondly, subsequent amendments are placed in
consecutive sheets. ie original in sheet 1, issue a in sheet 2 issue b
in sheet 3 etc.
From the above, I have two questions.
Q1 I need to prepare a vba statement within my code that literally
says, find the first populated cell (with any content) within a
specified range, copy the data and paste it in the position specified.
Q2 When extracting data from subsequent sheets where the files have
been amended, is it possible to highlight this in my history sheet by
adding (2) when the data has been extracted.

The following code is a segment and I have attached one of the template
files which is consistent with the rest of the files searched.

Any help would be greatly appreciated.

Cheers

Code:
--------------------

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long



Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "H:\treetest\files"
.FileType = msoFileTypeExcelWorkbooks


If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it

Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
Set basebook = ThisWorkbook
rnum = 1

For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("m2")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("l4")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 2). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("c3")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 3). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("h4")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 4). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
* Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("a14")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 5). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i*





wbResults.Close SaveChanges:=True


Next lCount
End If
End With






On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


End Sub

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


The range I wish the search to be in is A14:A38 and I have put the
segment where it is to ho in bold.

Once again,

Thanks

Jeff


+-------------------------------------------------------------------+
|Filename: template.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4735 |
+-------------------------------------------------------------------+

 

[1ceman]

Can this be done?

If so, I would appreciate some help in undertanding the way it works