通过 Excel VBA 复制粘贴单元格

Question

I have wrote a code which copies the Sheet1 Cells A2 and B2 then paste that cells into Sheet2 Cells G5 and G6.

I have been trying to create a loop that after first scenario when i run the code again it should copy the Cells A3 and B3 then paste into Cells G5 and G6 (these cell will always be same) .

I want to step forward by one row every time i run the macro.

I have tried with OFFSET function but it works just once.

Sub copy()
Dim lRow, i As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set sht1 = Sheet1
Set sht2 = Sheet2

sht1.Cells(2, 1).Offset(1, i).Copy Destination:=sht2.Cells(5, 7)
sht1.Cells(2, 2).Offset(1, i).Copy Destination:=sht2.Cells(6, 7)
End Sub

Answer 1

every time you run, locate the previous value in the input table and copy the next value

option explicit

Sub copy()

Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set sht1 = Sheet1
Set sht2 = Sheet2



dim r as range
set r = range(sht1.Cells(2, 1), sht1.Cells(2, 1).end(xlDown))

dim offset_row as variant

if isempty(sht2.Cells(5, 7).value) then
  offset_row=0
else
  offset_row=application.worksheetfunction.match(sht2.Cells(5, 7).value, r, 0)
endif

if not iserror(offset_row) then
  if offset_row <> r.rows.count then
    sht1.Cells(2, 1).offset(offset_row, 0).Copy Destination:=sht2.Cells(5, 7)
    sht1.Cells(2, 1).offset(offset_row, 1).Copy Destination:=sht2.Cells(6, 7)
  endif
endif



End Sub