從Sheet1復制范圍並將其粘貼到Sheet 2中

Question

我正在研究一個可以從sheet1復制數據並將其粘貼到sheet2的代碼。 下面的代碼沒有給我，但是它覆蓋了數據，我不確定為什么。 我做了一些代碼的實驗，但沒有用。

Dim iCounter%, Dest As Variant, SDest$, Lrow&
Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
Dim olMailItm As Object: Set olMailItm = olApp.CreateItem(0)

Sheet1.Unprotect "pramtesh": ActiveWorkbook.Unprotect "pramtesh"
Sheet2.Unprotect "pramtesh": ActiveWorkbook.Unprotect "pramtesh"

 Lrow = Sheet2.Cells(Rows.count, "B").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "C").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "D").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "E").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "F").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "G").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "H").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "I").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "J").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "K").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "L").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "M").End(xlUp).Row
 Lrow = Sheet2.Cells(Rows.count, "N").End(xlUp).Row

'additional verification
If Lrow < 1 Then 'if last used cell before [E2] then will be used [E2]
    Lrow = 1

Else 'otherwise move to the next cell after last filled cell
    Lrow = Lrow + 1
End If

Sheet1.Cells(2, 9).Copy Destination:=Sheet2.Cells(Lrow, "B")
Sheet1.Cells(5, 5).Copy Destination:=Sheet2.Cells(Lrow, "C")
Sheet1.Cells(6, 5).Copy Destination:=Sheet2.Cells(Lrow, "E")
Sheet1.Cells(7, 5).Copy Destination:=Sheet2.Cells(Lrow, "G")
Sheet1.Cells(8, 5).Copy Destination:=Sheet2.Cells(Lrow, "I")
Sheet1.Cells(9, 5).Copy Destination:=Sheet2.Cells(Lrow, "K")
Sheet1.Cells(10, 5).Copy Destination:=Sheet2.Cells(Lrow, "M")
Sheet1.Cells(5, 6).Copy Destination:=Sheet2.Cells(Lrow, "D")
Sheet1.Cells(6, 6).Copy Destination:=Sheet2.Cells(Lrow, "F")
Sheet1.Cells(7, 6).Copy Destination:=Sheet2.Cells(Lrow, "H")
Sheet1.Cells(8, 6).Copy Destination:=Sheet2.Cells(Lrow, "J")
Sheet1.Cells(9, 6).Copy Destination:=Sheet2.Cells(Lrow, "L")
Sheet1.Cells(10, 6).Copy Destination:=Sheet2.Cells(Lrow, "N")

ActiveSheet.Protect "pramtesh": ActiveWorkbook.Protect "pramtesh"

Sheet1.Unprotect "pramtesh": ActiveWorkbook.Unprotect "pramtesh"

Sheet1.Range("E5:F10").ClearContents
Sheet1.Range("I2").ClearContents

ActiveSheet.Protect "pramtesh": ActiveWorkbook.Protect "pramtesh"

With olMailItm
       .To = ""
       .Cc = ""
       .Subject = "Shift Log Out"
       .Body = ""
       .Display

Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
End With
Set olMailItm = Nothing:  Set olApp = Nothing

End Sub

Answer 1

復制目標位將始終粘貼在目標中的任何內容上。 所以代替：

Sheet1.Cells(2, 9).Copy Destination:=Sheet2.Cells(Lrow, "B")

嘗試：

Sheet1.Cells(2, 9).Copy
Sheet2.Cells(Lrow, "B").Insert