vba Excel循环遍历行并将单元格值复制到另一个工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17001631/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Looping through rows and copy cell values to another worksheet
提问by user2451335
I am facing some difficulty in achieving the desired result for my macro.
我在为我的macro.
Intention:
意图：
I have a list of data in sheets(input).column A(the number of rows that has value will vary and hence I created a loop that will run the macro until the activecell is blank).
我有一个数据列表sheets(input).column A（具有值的行数会有所不同，因此我创建了一个循环，该循环将运行宏直到活动单元格为空）。
My macro starts from Range(A2)and stretches all the way down column A, it stops only when it hits a blank row
我的宏从Range(A2)A 列开始并一直向下延伸，它仅在遇到空白行时停止
Desired result for the macro will be to start copying the cell value in sheet(input).Range(A2)paste it to sheet(mywork).Range(B2:B6).
宏的预期结果是开始复制单元格值sheet(input).Range(A2)并将其粘贴到sheet(mywork).Range(B2:B6).
For example, if "Peter" was the value in cell sheet(input),range(A2)then when the marco runs and paste the value into sheet(mywork) range(B2:B6). ie range B2:B6will reflect "Peter"
例如，如果“Peter”是单元格中的值，sheet(input),range(A2)那么当宏运行并将值粘贴到sheet(mywork) range(B2:B6). 即范围B2:B6将反映“彼得”
Then the macros loop back to sheet(input) & copy the next cell value and paste it to range(B7:B10)
然后宏循环回到工作表（输入）并复制下一个单元格值并将其粘贴到 range(B7:B10)
Example: "Dave" was the value in sheet(input) Range(A3), then "Dave" will be paste into the next 4 rows in sheet(mywork).Range(B7:B10). B7:B10will reflect "Dave"
示例：“Dave”是 中的值sheet(input) Range(A3)，然后“Dave”将粘贴到 中的下 4 行sheet(mywork).Range(B7:B10)。B7:B10将反映“戴夫”
Again repeating the same process goes back to sheet(input) this time range(A4), copys the value goes to sheet(mywork) and paste it into B11:B15.
再次重复相同的过程，这次返回到 sheet(input) range(A4)，将值复制到 sheet(mywork) 并将其粘贴到B11:B15.
Basically the process repeats....
基本上这个过程会重复......
The macro ends the when the activecell in sheet(input) column Ais empty.
当 activecell insheet(input) column A为空时，宏结束。
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("mywork").Activate
With ActiveSheet
.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
回答by user2432923
Private Sub CommandButton1_Click()
Dim Z As Long
Dim Cellidx As Range
Dim NextRow As Long
Dim Rng As Range
Dim SrcWks As Worksheet
Dim DataWks As Worksheet
Z = 1
Set SrcWks = Worksheets("Sheet1")
Set DataWks = Worksheets("Sheet2")
Set Rng = EntryWks.Range("B6:ad6")
NextRow = DataWks.UsedRange.Rows.Count
NextRow = IIf(NextRow = 1, 1, NextRow + 1)
For Each RA In Rng.Areas
For Each Cellidx In RA
Z = Z + 1
DataWks.Cells(NextRow, Z) = Cellidx
Next Cellidx
Next RA
End Sub
Alternatively
或者
Worksheets("Sheet2").Range("P2").Value = Worksheets("Sheet1").Range("L10")
This is a CopynPaste - Method
这是一个 CopynPaste - 方法
Sub CopyDataToPlan()
Dim LDate As String
Dim LColumn As Integer
Dim LFound As Boolean
On Error GoTo Err_Execute
'Retrieve date value to search for
LDate = Sheets("Rolling Plan").Range("B4").Value
Sheets("Plan").Select
'Start at column B
LColumn = 2
LFound = False
While LFound = False
'Encountered blank cell in row 2, terminate search
If Len(Cells(2, LColumn)) = 0 Then
MsgBox "No matching date was found."
Exit Sub
'Found match in row 2
ElseIf Cells(2, LColumn) = LDate Then
'Select values to copy from "Rolling Plan" sheet
Sheets("Rolling Plan").Select
Range("B5:H6").Select
Selection.Copy
'Paste onto "Plan" sheet
Sheets("Plan").Select
Cells(3, LColumn).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
LFound = True
MsgBox "The data has been successfully copied."
'Continue searching
Else
LColumn = LColumn + 1
End If
Wend
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
And there might be some methods doing that in Excel.
在 Excel 中可能有一些方法可以做到这一点。
