excel 循环以始终复制并粘贴到下一行

eh57zj3b  于 2022-12-01  发布在  其他
关注(0)|答案(4)|浏览(390)

我一直在寻找一种有效的方法来复制数据从一个电子表格到另一个,总是粘贴一行以下。有人帮我这个代码,但不幸的是它是不工作的列我需要。所以我需要复制数据从E2:P2的工作表“股息”和粘贴第一次在C11:N11,然后明天如果我再次运行应该粘贴在C12:N12和总是一行以下...当我运行代码,它粘贴的数据在C111:N111,如果我再次运行仍然粘贴在同一范围,所以不为我工作。我会感谢你的帮助。

Sub Copy_range()

    ' edit line below to change where data will be copied from
    Worksheets("Dividends").Range("E2:P2").Copy ' copy the value

    ' select the first cell on the "Draft" sheet
    Worksheets("Draft").Select
    ActiveSheet.Range("C11").Select

    Dim count As Integer
    count = 1

    'skip all used cells
    Do While Not (ActiveCell.value = None)
        ActiveCell.Offset(1, 0).Range("C11").Select
        count = count + 1

    Loop

    
    Worksheets("Draft").Range("C11" & count & ":N11" & count).PasteSpecial ' paste the value
  

End Sub
91zkwejq

91zkwejq1#

使用ActiveCell和Offset通常会导致意外的结果,并使代码难以阅读。您可以让计数循环在没有所有这些操作的情况下工作,只需从C11开始遍历C列单元格并查找空单元格即可。
一种可能的方法是

Sub Copy_range
      Dim count As Integer
      count = 11
      Do While Worksheets("Draft").Range("C" & count).Value <> ""
      '<>"" means "is not empty", as long as this happens we go down looking for empty cell
        count = count + 1
      Loop
      'Now count is row with first empty cell outside of top 10 rows in column C

      Worksheets("Dividends").Range("E2:P2").Copy
      Worksheets("Draft").Range("C" & count).PasteSpecial xlPasteValues

    End Sub
ua4mk5z4

ua4mk5z42#

我想说的是,你很可能只需要用一个自动填充到目标区域的Vlookup Formula就可以解决这个问题,但是下面的代码应该可以做到。

Option Explicit
Sub moveDividends()

Dim wsF As Worksheet 'From
Dim wsD As Worksheet 'Destination
Dim i As Long
Dim LastRow As Long

Set wsF = ThisWorkbook.Sheets("Sheet1")
Set wsD = ThisWorkbook.Sheets("Sheet2")

    With wsD
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).row
        Else
            LastRow = 1
        End If
    End With

    With wsD
        LastRow = LastRow + 1
            wsD.Cells(LastRow, "C").Value = wsF.Cells(2, 5).Value
            wsD.Cells(LastRow, "D").Value = wsF.Cells(2, 6).Value
            wsD.Cells(LastRow, "E").Value = wsF.Cells(2, 7).Value
            wsD.Cells(LastRow, "F").Value = wsF.Cells(2, 8).Value
            wsD.Cells(LastRow, "G").Value = wsF.Cells(2, 9).Value
            wsD.Cells(LastRow, "H").Value = wsF.Cells(2, 10).Value
            wsD.Cells(LastRow, "I").Value = wsF.Cells(2, 11).Value
            wsD.Cells(LastRow, "J").Value = wsF.Cells(2, 12).Value
            wsD.Cells(LastRow, "K").Value = wsF.Cells(2, 13).Value
            wsD.Cells(LastRow, "L").Value = wsF.Cells(2, 14).Value
            wsD.Cells(LastRow, "M").Value = wsF.Cells(2, 15).Value
            wsD.Cells(LastRow, "N").Value = wsF.Cells(2, 16).Value
    End With
End Sub
vs3odd8k

vs3odd8k3#

所有方法都是正确,或者简单地使用:

Sub Copy_range()
    Dim lastRow As Long
    ' edit line below to change where data will be copied from
    Worksheets("Dividends").Range("E2:P2").Copy ' copy the value
    ' find the 1th not-used rows
    lastRow = Worksheets("Draft").Cells(1048576, 3).End(xlUp).Row + 1
    lastRow = IIf(lastrows < 11, 11, lastrows) 'optional if is possible that the rows 10, 9, 8,.... are empty
    Worksheets("Draft").Range("C" & lastRow).PasteSpecial xlPasteValues ' paste the value
End Sub
yks3o0rb

yks3o0rb4#

使用以下

Sub Copy_range()
    ' edit line below to change where data will be copied from
    Worksheets("Dividends").Range("E2:P2").Copy ' copy the value

    'count cells and add 1 for next row
    last_row = Worksheets("Draft").Range("C" & Worksheets("Draft").Rows.Count).End(xlUp).Row + 1
    If last_row > 1000000 Then last_row = 1

    Worksheets("Draft").Range("C" & last_row ).PasteSpecial 
    ' paste the value only need to ref first cell
End Sub

相关问题