Excel 需要创建循环直到最后一行,但仅限于某些范围

Excel 需要创建循环直到最后一行,但仅限于某些范围,excel,vba,Excel,Vba,我需要值B5、C5和D5移动到下一行(B6、C6、D6等),直到最后一行,但“价格计算器其他区域”上的值需要保持固定 提前感谢您为价值转移而不是复制/粘贴所做的努力 Sub asd() Sheets("Price calculator other regions").Range("E6").Value = Sheets("Sheet1").Range("B5") Sheets("Price calculator other regions").Range("E25").Value = She

我需要值B5、C5和D5移动到下一行(B6、C6、D6等),直到最后一行,但“价格计算器其他区域”上的值需要保持固定


提前感谢您为价值转移而不是复制/粘贴所做的努力

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
要完成循环,只需使用计数器变量(variable
i
)将相关行号细分。要实现,请找到最后一行(由第1页B列决定),然后在行中循环

循环当前设置为从
活页1
的第二行开始。如果需要从第5行开始,请将i=5的循环更改为
,将循环更改为LR


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
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