将单元格范围复制到另一张纸上

Question

我要复制Form某个单元格区域，例如F10:F59 ，然后转置并将它们粘贴到另一个名为“ Stock Manual Senin表单中的另一个区域，例如B11:BA25 。

这是我目前拥有的：

 Sub InputPAGS_Senin() Dim copySheet As Worksheet Dim pasteSheet As Worksheet Dim vntRange As Variant Dim lastRow As Long Set copySheet = Sheets("Form") Set pasteSheet = Sheets("Stock Manual Senin") ' Calculate last row of data. lastRow = pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row ' Copy 2 cells. pasteSheet.Cells(lastRow + 1, 1).Offset(0, 1) = copySheet.Range("N2").Value ' Paste column range into array. vntRange = copySheet.Range("F10:F59").Value ' Paste transpose array into row range. Sheets("Stock Manual Senin").Select Range("B11:BA25").Select pasteSheet.Cells(lastRow + 1, 1).Offset(0, 3).Resize(, copySheet _ .Range("F10:F59").Rows.Count).Value = Application.Transpose(vntRange) End Sub 

粘贴目标应在row 11 ，但粘贴目标应在row 285因为目标范围位于其他表的行之间。

有人可以建议我如何继续吗？ 谢谢。

Answer 1

这样的事情行吗？ 当我写下这些值时，我只是做了一个手动操作。

Sub SOTest()
    Dim copySheet       As Worksheet
    Dim CopyRange       As Range
    Dim Cell            As Range
    Dim pasteSheet      As Worksheet
    Dim lastRow         As Long
    Dim ColIndex        As Long

    Set copySheet = ThisWorkbook.Worksheets("Form")
    Set pasteSheet = ThisWorkbook.Worksheets("Stock Manual Senin")
    Set CopyRange = copySheet.Range("F10:F59")
    ColIndex = 2 'Column B

    With pasteSheet
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    End With

    Application.ScreenUpdating = False
    For Each Cell In CopyRange
        pasteSheet.Cells(lastRow, ColIndex).Value = Cell.Value
        ColIndex = ColIndex + 1
    Next
    Application.ScreenUpdating = True

End Sub

Answer 2

xlUp变为xlDown

您必须从NAMA TOKO向下（xlDown）计算最后一行。 请勿删除NAMA TOKO和PAGS / MIGO ，然后可以使用以下命令

lastRow = pasteSheet.Cells(9, 2).End(xlDown).Offset(1).Row

甚至更好

lastRow = pasteSheet.Cells(9, 2).End(xlDown).Row + 1