Board index » Excel » Autocopy row from several worksheet to another workbook

Excel3
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?action=getinfo&userid=15930

View this thread: http://www.excelforum.com/showthread.php?threadid=276146


-

Sub Button1_Click()

Dim sht As Worksheet

i = 1

For Each sht In ThisWorkbook.Worksheets

If sht.Name <>"Sheet1" Then

Sheet1.Cells(i, 1) = sht.Range("B1")

i = i + 1

End If

Next

End Sub





- Manges



--

mangesh_yada

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

mangesh_yadav's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=1047

View this thread: http://www.excelforum.com/showthread.php?threadid=27614



-

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:

--



Dave Peterson

ec35720@netscape.com

-