Nhờ các thầy và các bạn trên diễn đàn viết dùm code copy cách dòng từ 1 mảng dử liệu (1 người xem)

[ntg82vn]

Em có một mảng dữ liệu (nằm ở sheet dữ liệu).
Bây giờ em muốn copy sang sheet tổng hợp. Tuy nhiên em muốn sẽ cách dòng ra .
Em có nêu lên ở bài toán trên.
Mong các thầy và các anh chị giúp đỡ.

 

[Phuocam]

@ntg82vn
Dùng thử :

Public Sub test()
Dim DuLieu, i As Long, lastRow As Long
With Sheets("Du lieu")
    lastRow = .Range("H" & Rows.Count).End(xlUp).Row
    DuLieu = .Range("H7:H" & lastRow).Value
End With
    For i = 1 To UBound(DuLieu, 1)
    Sheets("Tong hop").Range("B" & i * 6 - 1) = DuLieu(i, 1)
    Next i
End Sub

 

[Let'GâuGâu]

arr = [h7:h1000]
for i=1 to 1000
if arr(i,1)="" then exit for
if mod 7 mod 2 then
k=k+1
Result_arr(k,1)=arr(i,1)
end if

 

[Phuocam]

Chào mừng @Let'GâuGâu quay trở lại diễn đàn.

 

[befaint]

Tưởng bạn @Let'GâuGâu đi "Sao Hỏa" định cư rồi chứ...

Tàu của anh Musk hết xăng nên quay về nửa chừng.

 

[ntg82vn]

@ntg82vn
Dùng thử :

Public Sub test()
Dim DuLieu, i As Long, lastRow As Long
With Sheets("Du lieu")
    lastRow = .Range("H" & Rows.Count).End(xlUp).Row
    DuLieu = .Range("H7:H" & lastRow).Value
End With
    For i = 1 To UBound(DuLieu, 1)
    Sheets("Tong hop").Range("B" & i * 6 - 1) = DuLieu(i, 1)
    Next i
End Sub

Dạ cám ơn. Đúng ý em rồi ah.
Cám ơn thầy nhiều

 

[ntg82vn]

@ntg82vn
Dùng thử :

Public Sub test()
Dim DuLieu, i As Long, lastRow As Long
With Sheets("Du lieu")
    lastRow = .Range("H" & Rows.Count).End(xlUp).Row
    DuLieu = .Range("H7:H" & lastRow).Value
End With
    For i = 1 To UBound(DuLieu, 1)
    Sheets("Tong hop").Range("B" & i * 6 - 1) = DuLieu(i, 1)
    Next i
End Sub

Phiền thầy 1 chút nữa là làm sao để từ ô B đến ô H nó tự động dùng chức năng "merge & centrer"

 

[Phuocam]

Bạn chỉ cần nhập Địa chỉ: Họ tên cha ,họ tên mẹ, Lớp đang học từ B6 đến B9 rồi chạy code.

Public Sub test()
Dim DuLieu, i As Long, lastRow As Long
Application.ScreenUpdating = False
With Sheets("Du lieu")
    lastRow = .Range("H" & Rows.Count).End(xlUp).Row
    DuLieu = .Range("H7:H" & lastRow).Value
End With
With Sheets("Tong hop")
     For i = 1 To UBound(DuLieu, 1)
    .Range("B" & i * 6 - 1) = DuLieu(i, 1)
    .Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenterAcrossSelection
    .Range("B6:B9").Copy
    .Range("B" & i * 6).PasteSpecial Paste:=xlPasteValues
    Next i
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub

 

[be_09]

Cách làm là theo suy nghĩ của chủ Topic.
Tôi lại nghĩ khác:
- Cột H sheet Du lieu chỉ là 1 phần thông tin.
- Sheet Tong hop lại muốn in nhãn để làm cái gì đó thì chưa biết?

Theo tôi thì chủ Topic cần làm cái gì đó thì nên nêu rõ mục đích, còn giải pháp thì để các thành viên lo có nhiều khi nó hay hơn và tiện lợi hơn.
Không lẽ, có phát sinh thêm thì lại hỏi tiếp, chắc các code nêu trên phá sản quá.

 

[van_utc]

Cái này em thấy có 1 tẹo giống như PivotTablet.

 

[ntg82vn]

Cách làm là theo suy nghĩ của chủ Topic.
Tôi lại nghĩ khác:
- Cột H sheet Du lieu chỉ là 1 phần thông tin.
- Sheet Tong hop lại muốn in nhãn để làm cái gì đó thì chưa biết?

Theo tôi thì chủ Topic cần làm cái gì đó thì nên nêu rõ mục đích, còn giải pháp thì để các thành viên lo có nhiều khi nó hay hơn và tiện lợi hơn.
Không lẽ, có phát sinh thêm thì lại hỏi tiếp, chắc các code nêu trên phá sản quá.

Cám ơn sự góp ý của thầy.
Bởi em chỉ cần như vậy. còn các thông tin ở giữa em đã làm được.
Tuy nhiên do không biết viết code (mà chỉ có khả năng sửa code) nên em muốn nhờ để học hỏi thêm.

 

[ntg82vn]

Bạn chỉ cần nhập Địa chỉ: Họ tên cha ,họ tên mẹ, Lớp đang học từ B6 đến B9 rồi chạy code.

Public Sub test()
Dim DuLieu, i As Long, lastRow As Long
Application.ScreenUpdating = False
With Sheets("Du lieu")
    lastRow = .Range("H" & Rows.Count).End(xlUp).Row
    DuLieu = .Range("H7:H" & lastRow).Value
End With
With Sheets("Tong hop")
     For i = 1 To UBound(DuLieu, 1)
    .Range("B" & i * 6 - 1) = DuLieu(i, 1)
    .Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenterAcrossSelection
    .Range("B6:B9").Copy
    .Range("B" & i * 6).PasteSpecial Paste:=xlPasteValues
    Next i
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub

Cám ơn thầy.
Em đã sửa lại một chút như thế này:
Hơi dài dòng một chút nhưng em chỉ có thể làm được đến vậy thôi.

Public Sub test_1()
Dim DuLieu, i As Long, lastRow As Long
With Sheets("Du lieu")
lastRow = .Range("H" & Rows.Count).End(xlUp).Row
DuLieu = .Range("H7:H" & lastRow).Value
End With
For i = 1 To UBound(DuLieu, 1)
Sheets("Tong hop").Range("B" & i * 6 - 1) = DuLieu(i, 1)
'Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenterAcrossSelection
Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).Merge
Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenter
Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).VerticalAlignment = xlCenter
Next i
End Sub

 

[Phuocam]

Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).Merge
Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenter
Sheets("Tong hop").Range("B" & i * 6 - 1).Resize(1, 7).VerticalAlignment = xlCenter

Đâu cần 3 dòng này. Chỉ cần:

.Range("B" & i * 6 - 1).Resize(1, 7).HorizontalAlignment = xlCenterAcrossSelection

là dữ liệu được canh giữa 7 ô bạn chọn.

 

[ntg82vn]

Đâu cần 3 dòng này. Chỉ cần:

là dữ liệu được canh giữa 7 ô bạn chọn.

Vâng em lại biết thêm "xlCenterAcrossSelection " nữa rồi.
Em cám ơn thầy rất nhiều.