从Sheet1复制范围并将其粘贴到工作表2中

时间:2015-05-04 16:20:31

标签: vba excel-vba excel

我正在处理一个代码,它可以从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

1 个答案:

答案 0 :(得分:0)

复制目标位始终会粘贴目标中的任何内容。所以而不是:

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

尝试:

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