[英]loop to copy and paste always one row below
I have been searching an efficient way to copy data from one spreadsheet to another and always paste one row below.我一直在寻找一种将数据从一个电子表格复制到另一个电子表格的有效方法,并且总是在下面粘贴一行。 Someone helped me with this code, but unfortunately it is not working for the columns i need.
有人帮我处理了这段代码,但不幸的是它不适用于我需要的列。 So I need to copy data from E2:P2 on sheet "Dividends" and paste firstly on C11:N11, then tomorrow if I run again should paste on C12:N12 and always one row below... When I run the code, it pastes the data on C111:N111, and if I run again still paste on the same range, so does not work for me.
所以我需要从 E2:P2 复制数据在“股息”表上并首先粘贴到 C11:N11 上,然后明天如果我再次运行应该粘贴到 C12:N12 上并且总是下面的一行......当我运行代码时,它将数据粘贴到 C111:N111 上,如果我再次运行仍然粘贴在同一范围内,所以对我不起作用。 I would appreciate your help.
我会很感激你的帮助。
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
Using ActiveCell and Offset can often lead to unexpected results and makes the code hard to read.使用 ActiveCell 和 Offset 通常会导致意外结果并使代码难以阅读。 You can have the counting loop working without all of this, by simply going through column C cells starting at C11 and looking for empty one.
您可以让计数循环在没有所有这些的情况下工作,只需通过从 C11 开始的 C 列单元格并寻找空单元格即可。
One of possible ways is一种可能的方法是
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
I would say that you could most likely just solve this with a Vlookup Formula
autofilled to the target area.我想说的是,您很可能只需使用自动填充到目标区域的
Vlookup Formula
来解决这个问题。 But the below code should do it.但是下面的代码应该可以做到。
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
all method are rigth, or simply use:所有方法都是正确的,或者简单地使用:
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
Use the below使用以下
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.