Нужно создать цикл до последней строки, но только для определенных диапазонов

Question

Sub asd()

Sheets("Price calculator other regions").Range("E6").Value = Sheets("Sheet1").Range("B5")

Sheets("Price calculator other regions").Range("E25").Value = Sheets("Sheet1").Range("C5")

Sheets("Sheet1").Range("D5").Value = Sheets("Price calculator other regions").Range("E32")

End Sub

Мне нужно, чтобы значения B5, C5 и D5 переместились на одну строку ниже (B6, C6, D6 и т. Д.) До последней строки, но значения в «Калькуляторе цен для других регионов» должны оставаться фиксированными.

Заранее спасибо

Answer 1

Слава за переход на передачу значения вместо копирования / вставки!

Чтобы завершить цикл, вам просто нужно добавить соответствующие номера строк в переменную счетчика (переменная i). Для реализации найдите последнюю строку (определенную Sheet 1 Column B), затем выполните цикл по строкам.

Цикл в настоящее время настроен на запуск во 2-й строке на Sheet 1. Если вам нужно начать с 5-го ряда, измените цикл на For i = 5 to LR

---

Sub asd_v2()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ps As Worksheet: Set ps = ThisWorkbook.Sheets("Price calculator other regions")

Dim LR As Long, i As Long
LR = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

For i = 2 To LR
    ps.Range("E6").Value = ws.Range("B" & i).Value
    ps.Range("E25").Value = ws.Range("C" & i).Value
    ws.Range("D" & i).Value = ps.Range("E32").Value
Next i

End Sub

Answer 2

Dim r as range
set r = Sheets("Sheet1").Range("B5")
do  'start loop
with Sheets("Price calculator other regions")

.Range("E6").Value = r

.Range("E25").Value = r.offset(0,1)

r.offset(0,2) = .Range("E32")
set r = r.offset(1,0)
loop until r.row > r.parent.usedrange.rows.count

end with