help to copy range to another sheet when meet conditions

[nhnn1986]

Hi all

I want to have macro do that:
find each cell in sheet(3144).column(B) with value = "R-101" then
Copy range(Ei:Ni) to sheets(02).range(Cz:Lz)
Copy 8th characters from range (Ai) to sheets(02).range(Bz)

with: i = 2 to last row in sheet(3144)
and z = 10 to last row in sheets(02)
My code belove don't work, please help me

Sub Copy()Dim lrowa As Long, j As Long, z As Long


With Sheets("3144")
    lrowa = .Cells(Rows.Count, 1).End(xlUp).Row
        For j = 2 To lrowa
            For z = 10 To Sheets("02").Cells(Rows.Count, "C").End(xlUp).Row
                If .Cells(j, "B").Value = "R-101" Then
                .Range(.Cells(j, "E"), .Cells(j, "N")).Copy Sheets("02").Range("C" & z)
                Sheets("02").Range("B" & z).Value = Mid(.Range("A" & j), 8, 8)
                End If
            Next z
            
        Next j
       
End With
End Sub

 

[DanteAmor]

Try this

Sub copy_range()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim lr As Long, j As Long, i As Long
        
    Set sh1 = Sheets("3144")
    Set sh2 = Sheets("02")
    
    j = 10
    lr = sh1.Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        If sh1.Cells(i, "B").Value = "R-101" Then
            sh2.Cells(j, "B").Value = Mid(sh1.Cells(i, "A"), 8, 8)
            sh2.Cells(j, "C").Resize(, 10).Value = sh1.Cells(i, "E").Resize(, 10).Value
            j = j + 1
        End If
    Next
End Sub

 

[nhnn1986]

Thanks @DanteAmor code worked.

May i have another question is: I want macro todo more that for each sh2.cells(j,"B") has just found, compare with sheets("name").range("A5:A") then copy value match to sh2.Cells(j,"A")

Thanks for your help./.

 

[nhnn1986]

Please help me in #3

 

[DanteAmor]

You can explain it with examples

 

[nhnn1986]

Yes I want macro to do more that:

[COLOR=#49644E]for each sh2.cells(j,"B") has just found, compare with sheets("name").range("A5:A") then copy value match to sh2.Cells(j,"A")
[/COLOR]with sh2
For each cells(j,"B") , j = 10 to last row
if .cells(j,"B").value = sheets("name").cells(x,"A").value then , x = 5 to last row
.Cells(j,"A").value = sheets("name").cells(x,"D").value
end if
end with

 

[DanteAmor]

So it works?

 

[nhnn1986]

Code can't work so I want to help one again

 

[DanteAmor]

Ahhhh
Then, again: You can explain it with examples

 

[nhnn1986]

Ahhhh
Then, again: You can explain it with examples

That's great, I've just found another way to do this with find method. This code belove work with me and this thread has Solved. Many thanks Dante for your respond

With sh2        For w = 10 To .Cells(.Rows.Count, "B").End(xlUp).Row
            ans = .Range("B" & w).Value
        Set found = sheets("name").Columns("A:A").Find(what:=ans)
            If found Is Nothing Then
            .Range("B" & w).Value = "noname"
            Else
            frow = sheets("name").Columns("A:A").Find(what:=ans).Row
            .Range("A" & w).Value = sheets("main").Range("C" & frow).Value
            End If
        Next
    End With

<coccocgrammar></coccocgrammar>