Excel循环遍历行并将单元格值复制到另一个工作表答案

【问题标题】：Excel Looping through rows and copy cell values to another worksheetExcel循环遍历行并将单元格值复制到另一个工作表
【发布时间】：2013-06-04 19:05:26
【问题描述】：

我在为我的macro 实现预期结果方面遇到了一些困难。

意图：

我在sheets(input).column A 中有一个数据列表（具有值的行数会有所不同，因此我创建了一个循环，该循环将运行宏，直到活动单元格为空白）。

我的宏从Range(A2) 开始，一直延伸到 A 列，只有在遇到空白行时才会停止

宏的预期结果是开始复制sheet(input).Range(A2) 中的单元格值，并将其粘贴到sheet(mywork).Range(B2:B6)。

例如，如果“Peter”是单元格 sheet(input),range(A2) 中的值，那么当 marco 运行时，将该值粘贴到 sheet(mywork) range(B2:B6) 中。即范围B2:B6 将反映“彼得”

然后宏循环回到工作表（输入）并复制下一个单元格值并将其粘贴到range(B7:B10)

示例：“Dave”是sheet(input) Range(A3) 中的值，然后“Dave”将粘贴到sheet(mywork).Range(B7:B10) 中接下来的 4 行。 B7:B10 将反映“戴夫”

再次重复相同的过程，这次将返回工作表（输入）range(A4)，将值复制到工作表（mywork）并将其粘贴到B11:B15。

这个过程基本上是重复的......

当sheet(input) column A中的activecell为空时，宏结束。

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

【问题讨论】：

标签： vba excel excel-2010

【解决方案1】：

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

或者

Worksheets("Sheet2").Range("P2").Value = Worksheets("Sheet1").Range("L10")

这是一个 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

在 Excel 中可能有一些方法可以做到这一点。

【讨论】：