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

Question

I want to copy a range of cells, say F10:F59 , of the Form sheet, then transpose and paste them to another range on another sheet named Stock Manual Senin , say B11:BA25 .

This is what I currently have:

 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 

the paste target should be in row 11 , but it'd paste in row 285 cause target range is located between the others table's row.

Can anyone advise me on how I should continue please? Thank you.

Answer 1

Does something like this work? I just did a manual pivot as I wrote out the values.

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 Becomes xlDown

You have to calculate the last row from NAMA TOKO down (xlDown). Do not delete NAMA TOKO and PAGS / MIGO , then you can use the following

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

or even better

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