[英]Excel VBA: Loop through cells and copy values to another worksheet
Facing some diffculty in achieving the desired result. 在实现预期结果时遇到困难。 Current results = for example the last value in sheets(input) is "Peter" then the entire column in sheets(sheet1) will just reflect Peter
当前结果=例如,sheets(input)中的最后一个值是“ Peter”,则sheets(sheet1)中的整个列将仅反映Peter
Desired result = last 2 rows value in sheets(input) is "david" then "peter" what i hope to achieved in sheets(Sheet1) is range(B5:B8) reflecting "david" and Range(B9:B12) "Peter" 所需的结果= sheets(input)中的最后2行值是“ david”,然后是“ peter”,我希望在sheets(Sheet1)中实现的范围是反映“ david”的range(B5:B8)和Range(B9:B12)“ Peter ”
Hope you guys here can give some advice on this matter. 希望你们在这方面能提供一些建议。 thanks in advance :)))
提前致谢 :)))
Sub playmacro()
Dim xxx As Long, yyy As Long
ThisWorkbook.Sheets("Input").Range("A2").Activate
Do While ActiveCell.Value <> ""
DoEvents
ActiveCell.Copy
For xxx = 2 To 350 Step 4
yyy = xxx + 3
Worksheets("Sheet1").Activate '"select Sheet1"
With ActiveSheet
'copy the first active cell value from worksheet "input" and paste onto "sheet1" range("B2:B5") basically 1 cell value will occupy 4 rows in "sheet1"
'then jump to the next empty row, return back to worksheet "input" copy the next row value and paste the data into range("B6:B9")
'the loop will keep repeating until sheet "input" activecell value is blank
.Range(Cells(xxx, 2), Cells(yyy, 2)).PasteSpecial xlPasteValues
End With
Next xxx
ThisWorkbook.Sheets("Input").Select
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = True
End Sub
Not sure I fully understood your requirements, but maybe this is what you need: 不确定我是否完全理解您的要求,但是也许这是您所需要的:
Sub PlayMacro()
Dim lngLastRow as Long
With Sheets("Input")
lngLastRow = .Range(.Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Range("B5:B8").Value = .Range(lngLastRow-1,1).Value
Sheets("Sheet1").Range("B9:B12").Value = .Range(lngLastRow,1).Value
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.