Excel循环行并将单元格值复制到另一个工作表
我在为我的macro达到预期的结果时遇到一些困难。
意图 ：
我有一个数据sheets(input).column A （具有值的行数会有所不同，因此我创build了一个循环，将运行macros，直到活动单元为空）的数据列表。
我的macros从Range(A2) ，一直延伸到A列，只有当它到达一个空行时才停止
macros的期望结果将开始复制工作sheet(input).Range(A2)的单元格值粘贴到工作sheet(mywork).Range(B2:B6) 。
例如，如果“Peter”是单元格sheet(input),range(A2)的值sheet(input),range(A2)那么当marco运行并将值粘贴到sheet(mywork) range(B2:B6) 。 即范围B2:B6将反映“彼得”
然后macros循环回工作表（input）并复制下一个单元格的值并粘贴到range(B7:B10)
例如 ：“Dave”是工作sheet(input) Range(A3) ，则“Dave”将被粘贴到工作sheet(mywork).Range(B7:B10)的下4行中。 B7:B10会反映“Dave”
再次重复相同的过程返回到表（input）这个时间range(A4) ，将值复制到工作表（mywork）并粘贴到B11:B15 。
基本上这个过程重复…
sheet(input) column A为空时macros结束。
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
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中可能有一些方法。