首页 > 解决方案 > 复制列中的最后一个单元格并偏移 1

问题描述

我有一个代码,它从一张表中复制一组值并将其粘贴到另一张表中,现在我想将最后填充的行偏移 1 并删除原始行,即如果最后一行是 L12:(整行),它被粘贴到L13 和 L12 行为空。

Dim ws As Worksheet
Set ws = Worksheets("Pivot_WH calculations") 'change name as needed

With ws
   'assumes data is in a "table" format with all data rows in column A and data columns in row 1

   .Range("E2:J7").Copy _
    Worksheets("WH Calc_new").Range("L" & .Rows.Count).End(xlUp).Offset(2)

    .Range("E8:J8").Copy _
    Worksheets("WH Calc_new").Range("L" & .Rows.Count).End(xlUp).Offset(2)

   .Range("A2:A9").Copy _
    Worksheets("WH Calc_new").Range("K" & .Rows.Count).End(xlUp).Offset(2)
End With

End Sub


标签: excelvba

解决方案


  • 最后的函数将为您提供最后一行,这实际上是工作表中使用的最后一行。

  • 对于偏移量,您可以将 2 更改为 3 或 4 或您想要偏移的任何其他数字.Offset(Number_Here)

尝试这个:

Sub cdd()

Dim ws As Worksheet
Dim lst As Long

Set ws = Worksheets("Pivot_WH calculations") 'change name as needed
lst = LastRow(Worksheets("WH Calc_new"))

With ws

    .Range("E2:J7").Copy Worksheets("WH Calc_new").Range("L" & lst).Offset(2)

    .Range("E8:J8").Copy Worksheets("WH Calc_new").Range("L" & lst).Offset(2)

    .Range("A2:A9").Copy Worksheets("WH Calc_new").Range("K" & lst).Offset(2)

End With

End Sub
Function LastRow(Sh As Worksheet)
    On Error Resume Next
    LastRow = Sh.Cells.Find(What:="*", _
                            After:=Sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).row
    On Error GoTo 0
End Function

推荐阅读