Option Explicit
Sub copy()
Dim rS As Range
Dim rD As Range
Dim lNumberRow As Long
Dim lNumberRowS As Long
Dim lNumberColS As Long
Dim lStartS As Long
Dim lStopS As Long
Dim lIndexD As Long
Dim vData As Variant
On Error Resume Next
Set rS = Application.InputBox("Lua chon vung copy", Type:=8)
If Err.Number <> 0 Then Exit Sub
If rS.Areas.Count > 1 Then Exit Sub
Set rD = Application.InputBox("Lua chon vung paste", Type:=8)
If Err.Number <> 0 Then Exit Sub
Set rD = rD.Cells(1, 1) 'lay o dich
lNumberRow = Application.InputBox("So dong copy", Type:=1)
If Err.Number <> 0 Then Exit Sub
If lNumberRow <= 0 Then MsgBox "Loi": Exit Sub
lNumberRowS = rS.Rows.Count
lNumberColS = rS.Columns.Count
lIndexD = 0
lStartS = 1
Do While 1
lStopS = lStartS + lNumberRow - 1
If lStopS > lNumberRowS Then lStopS = lNumberRowS
vData = rS.Offset(lStartS - 1).Resize(lStopS - lStartS + 1)
rD.Offset(lIndexD).Resize(lNumberColS, (lStopS - lStartS + 1)) = Application.WorksheetFunction.Transpose(vData)
If lStopS >= lNumberRowS Then Exit Sub
lStartS = lStopS + 1
lIndexD = lIndexD + lNumberColS
Loop
End Sub
