копировать ячейки по условию на другой лист

[f_murtazin]

Добрый день

пытаюсь разобраться в vba подскажите пожалуйста, что нет так?

как должно работать
если на листе "свод по банкам" в строке, значение в столбце B = RUB нужно скопировать значение строки в столбцах A,D,G,J на лист "T042A rub" в столбцы A,B,C,D

если значение <>RUB значения этой строки не копировать

что не так в коде, отрабатывает без ошибок, но результата нет

[Aleksandr H.]

А макрос-то где собственно?

[f_murtazin]

Sub Macros()
Dim sh As Worksheet, sh2 As Worksheet
Dim rng As Range, i As Long, r As Long, shr As Long
Set sh = Sheets("свод по банкам")
Set sh2 = Sheets("T042A rub")
' строк в исходном
shr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
With sh
' перебираем элементы
For i = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row
' найдено совпадение
If sh.Cells(i, "B") = RUB Then
' последняя строка
r = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row + 1
' перенос значений
.Cells(sh2, "A") = .Cells(sh, "A")
.Cells(sh2, "B") = .Cells(sh, "D")
.Cells(sh2, "C") = .Cells(sh, "B")
.Cells(sh2, "D") = .Cells(sh, "J")
' выход из цикла
Exit For
End If
Next i
End With
Set sh = Nothing
Set sh2 = Nothing
End Sub

[Aleksandr H.]

For i = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row
' найдено совпадение
If .Cells(i, "B") = "RUB" Then
' последняя строка
r = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row + 1
' перенос значений
sh2.Cells(r, "A") = .Cells(i, "A")
sh2.Cells(r, "B") = .Cells(i, "D")
sh2.Cells(r, "C") = .Cells(i, "B")
sh2.Cells(r, "D") = .Cells(i, "J")
' выход из цикла
Exit For
End If
Next i

[IgorGO]

Sub CopyRub()
  Dim sh As Worksheet, rg1 As Range, rg2 As Range, r&, re&, r2&
  Set sh = Worksheets("T042A rub")
  With Worksheets("свод по банкам")
    re = .Cells(.Rows.Count, 1).End(xlUp).Row
    r2 = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row + 1
    Set rg1 = .Range("A1:D1"): Set rg2 = sh.Range("A1:D1")
    For r = 3 To re
      If .Cells(i, "B") = "RUB" Then
        gr2.Offset(r2 - 1) = rg1.Offset(r - 1): r2 = r2 + 1
      End If
    Next i
  End With
End Sub