Get Data from One sheet to Other

[K]

Hi all, I have two Sheets in workbook. One sheet name is "Search" and
Other sheet name is "Data". In sheet "Data" I have data like (see
below)

A B C D---- columns
555360 XX1 12 XXZ4
555360 XX2 13 XDX5
555360 XX3 14 TYU4
555360 XX4 15 GHJ4
523600 GH5 16 ERT6
523600 GH6 17 XSE8
523600 GH7 18 FDS2
589632 ZR2 19 SDR9
589632 ZR3 20 HYU1
589632 ZR4 21 SEW1

In sheet "Search" I want macro on a button that when I put any number
of column A cells of sheet "Data" in Sheets("Search").Range("A1") then
by clicking the button macro should look that number in column A of
sheet "Data" and copy rows from column A to column D (not EntireRow)
of that number to sheet "Search" in Range("A6") to down. For exampe
if i put number "523600" in Range("A1") of sheet "Search" then when i
click button macro should look this number in column A of sheet "Data"
and copy rows from column A to D in sheet "Search" in Range("A6") to
down. The result will be somthing like this (see below)

A B C D---- columns
523600 GH5 16 ERT6
523600 GH6 17 XSE8
523600 GH7 18 FDS2

I hope I was able to explain my question. Can any friend can help

 

[Joel]

Sub Search()
'
' Macro3 Macro
' Macro recorded 11/20/2008 by jwarburg
'

'
SearchRowCount = 1
With Sheets("Search")
DataRowCount = 1
Do While .Range("A" & SearchRowCount) <> ""
SearchNum = .Range("A" & SearchRowCount)
With Sheets("Data")
First = True
DataRowCount = 1
Do While .Range("A" & DataRowCount) <> ""
DataNum = .Range("A" & DataRowCount)
If DataNum = SearchNum Then
If First = True Then
.Range("A" & DataRowCount & "" & DataRowCount).Copy _
Destination:=Sheets("Search").Range("A" & SearchRowCount)
First = False
Else
.Range("A" & DataRowCount & "" & DataRowCount).Copy
Sheets("Search").Range("A" & (SearchRowCount + 1)).Insert
shift:=xlDown
SearchRowCount = SearchRowCount + 1
End If
End If
DataRowCount = DataRowCount + 1
Loop
SearchRowCount = SearchRowCount + 1
End With
Loop
End With
End Sub

 

[K]

Thanks Joel your code works perfectly fine. Just for my knowledge
that i created the macro see below

Sub srch()
Dim c As Range
Lcl = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
i = 6
For Each c In Sheets("Data").Range("A" & Lcl).Cells
If Range("A1").Value = c.Value Then
c.EntireRow.Copy Range("A" & i)
End If
i = i + 1
Next
End Sub

It has two problems
1 - at the moment its coping EntireRow but what code line i should add
in it that it should copy rows from column A to D
2 - at the moment its pasting only in row 6 but how can i make it to
paste row 6 to down.
your help will be much appricated. Thanks

 

[Joel]

Sub srch()
Dim c As Range
Lcl = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
i = 6
For Each c In Sheets("Data").Range("A" & Lcl).Cells
If Range("A1").Value = c.Value Then
Range("A" & c.row & "" & c.Row).Copy Range("A6:A" & Ld)
End If
i = i + 1
Next
End Sub

 

[K]

Sub srch()
Dim c As Range
Lcl = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
i = 6
For Each c In Sheets("Data").Range("A" & Lcl).Cells
If Range("A1").Value = c.Value Then
Range("A" & c.row & "" & c.Row).Copy Range("A6:A" & Ld)
End If
i = i + 1
Next
End Sub







- Show quoted text -

Thanks lot joel