View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.misc
M.A.Tyler
 
Posts: n/a
Default Moving An Entire Row From One Sheet To Another

Thanks Mudraker.... thats just the ticket!

"mudraker" wrote:


Here are 2 macros

The 1st one checks each cell sheet5 column c one cell at a time against
value in sheet3 g3 if match then checks value same row in column ae.
This could be slow if you have a lot of used rows in sheet 5

the 2nd macro uses AutoFilter and you would need to turn auto filter on
in sheet 5.


Sub CopyRow()
Dim wS1 As Worksheet
Dim wS5 As Worksheet
Dim lRow As Long
Dim iValC As Integer
Dim iValAE As Integer
Dim Rng As Range

Set wS1 = Sheets("Sheet1")
Set wS5 = Sheets("sheet5")

iValC = wS1.Range("g3").Value
iValAE = wS1.Range("ae5").Value

For Each Rng In wS5.Range("c2:c" _
& wS5.Cells(Rows.Count, _
"a").End(xlUp).Row)
If Rng.Value = iValC Then
If Cells(0, "ae").Value = iValAE Then
wS5.Rows(Rng.Row).Copy wS1.Rows(19)
Exit For
End If
End If
Next Rng
End Sub


Sub CopyFilterData()
Dim wS1 As Worksheet
Dim wS5 As Worksheet
Dim Rng As Range

Set wS1 = Sheets("Sheet1")
Set wS5 = Sheets("sheet5")

wS5.AutoFilterMode = False
wS5.Activate
Selection.AutoFilter


Selection.AutoFilter Field:=3, Criteria1:=wS1.Range("g3").Value
Selection.AutoFilter Field:=31, Criteria1:=wS1.Range("ae5").Value

With wS5.AutoFilter.Range
On Error Resume Next
' This example will not copy the header row
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then
'Copy the cells
Rng.Copy wS1.Rows(19)
End If
End With
End Sub


--
mudraker
------------------------------------------------------------------------
mudraker's Profile: http://www.excelforum.com/member.php...fo&userid=2473
View this thread: http://www.excelforum.com/showthread...hreadid=537071