[英]loop to copy and paste always one row below
我一直在尋找一種將數據從一個電子表格復制到另一個電子表格的有效方法,並且總是在下面粘貼一行。 有人幫我處理了這段代碼,但不幸的是它不適用於我需要的列。 所以我需要從 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
使用 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
我想說的是,您很可能只需使用自動填充到目標區域的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
所有方法都是正確的,或者簡單地使用:
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
使用以下
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.