Autocopy row from several worksheet to another workbook
 

I assumed that you're pasting into the same worksheet.

Option Explicit
Sub testme()

Dim Wkbk As Workbook
Dim wks As Worksheet
Dim destWks As Worksheet
Dim destCell As Range

Dim myRng As Range
Dim FoundCell As Range
Dim AllCells As Range
Dim FirstAddress As String
Dim whatToFind As String

Set Wkbk = Workbooks("book1.xls")
Set destWks = Workbooks("book2.xls").Worksheets("sheet1")

whatToFind = "hithere!"

For Each wks In Wkbk.Worksheets
With wks
FirstAddress = ""
Set myRng = .Range("B:b")
With myRng
Set FoundCell = .Cells.Find(what:=whatToFind, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)

If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
With destWks
Set destCell = .Cells(.Rows.Count, "B").End(xlUp) _
.Offset(1, -1)
End With
FoundCell.EntireRow.Resize(1, 14).Copy _
Destination:=destCell
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address < FirstAddress
End If
End With
End With
Next wks

End Sub

Both workbooks must be open.

Set Wkbk = Workbooks("book1.xls")
Set destWks = Workbooks("book2.xls").Worksheets("sheet1")

book1.xls is the workbook that will be searched through.
sheet1 in book2.xls will be where the data will be pasted.

I used column b to find the next available row.

Take a look at that .find line. You'll want to adjust it to match what you need
(xlwhole/xlpart, matchcase stuff).


hme wrote:

Hi
How can copy a row with a given range (text) in column B, from several
worksheets to another workbook.
thanks
HME

--
hme
------------------------------------------------------------------------
hme's Profile: http://www.excelforum.com/member.php...o&userid=15930
View this thread: http://www.excelforum.com/showthread...hreadid=276146

--

Dave Peterson