Bạn chạy thử Code này nhé.
Sub chuyendulieu()
Dim arr, arr1, i As Long, j As Long, a As Long, lr As Long
With Sheets("Sheet 1")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A1:C" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 5)
End With
For i = 1 To UBound(arr, 1) Step 5
a = a + 1
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = arr(i + 1, 1)
arr1(a, 3) = arr(i + 2, 2)
arr1(a, 4) = arr(i + 3, 2)
arr1(a, 5) = arr(i + 4, 2)
Next i
With Sheets("sau chinh sua")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A2:E" & lr).ClearContents
If a Then .Range("A2").Resize(a, 5).Value = arr1
End With
End SubHix em gà quá. phiền bác chỉ em " nút kết quả" ở đâu. Mong bác thông cảm, em thực sự rất gà về excel.
Bạn chạy code này xem nhé.
Sub chuyendulieu()
Dim arr, arr1, i As Long, j As Long, a As Long, lr As Long
With Sheets("Sheet 1")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A1:C" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 11)
End With
If UBound(arr, 1) Mod 11 Then MsgBox "dulieusai": Exit Sub
For i = 1 To UBound(arr, 1) Step 11
a = a + 1
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = arr(i + 1, 1)
arr1(a, 3) = arr(i + 2, 2)
arr1(a, 4) = arr(i + 3, 2)
arr1(a, 5) = arr(i + 4, 2)
arr1(a, 6) = arr(i + 5, 2)
arr1(a, 7) = arr(i + 6, 2)
arr1(a, 8) = arr(i + 7, 2)
arr1(a, 9) = arr(i + 8, 2)
arr1(a, 10) = arr(i + 9, 2)
arr1(a, 11) = arr(i + 10, 2)
a = a + 1
Next i
With Sheets("sau chinh sua")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A2:k" & lr).ClearContents
If a Then .Range("A2").Resize(a, 11).Value = arr1
End With
End Sub
