循环到复制和粘贴,始终在下方一行
原标题：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. 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. 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.
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. 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
