[Hỏi] - VBA Vòng Lặp Do Until - Copy vùng dữ liệu nhiều dòng như thế nào

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

0981858549

Thành viên mới
Tham gia
16/12/19
Bài viết
10
Được thích
1
Untitled.jpg
Mọi người giành chút thời gian giúp mình với ạ!
Mình có một vùng dữ liệu như trên: vùng C5:G17
- Mình muốn copy vùng dữ liệu trên xuống phía dưới với điều kiện MỖI LẦN CHỈ COPY 4 DÒNG
- Lặp lại cho đến khi nào bảng trên hết dữ liệu
Cụ thể minh muốn copy vùng C6:G17 xuống ô C22, sau đó copy tiếp vùng C10:G13, copy tiếp vùng C14:G17... cho đến hết dữ liệu bảng

Mình hỏi thế để mình có thể copy những trường hợp tương tự qua 1 sheet khác, hoặc những nơi khác. Khi mà nơi đó chỉ cho nhập mỗi lần một số dòng giới hạn, như VD trên chỉ được nhập 4 dòng chẳng hạn.
Cảm ơn mọi người nhiều
 
Lần chỉnh sửa cuối:

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia
8/6/06
Bài viết
13,652
Được thích
21,063
Nghề nghiệp
Bên kia sườn dốc
Bạn thử chiêm nghiệm cái For . . . Next trước khi Do . . . Loop

PHP:
Sub CopyNhom4()
 Dim Rws As Long, J As Long, Col As Integer, NN As Integer
 Const CPy As Byte = 4
 Dim fRg As Range
 
 Rws = [C5].End(xlDown).Row
 Col = [C5].CurrentRegion.Columns.Count
 Set fRg = Cells(Rws + 4, "C")
 For J = 5 To Rws Step CPy
    Cells(J, "C").Resize(CPy, Col).Copy Destination:=fRg.Offset(NN + 4)
    NN = NN + CPy
 Next J
 MsgBox "Xong Rôi!"
End Sub
 

VetMini

Ăn cùng góc phố
Tham gia
21/12/12
Bài viết
15,111
Được thích
20,155
...
Mình hỏi thế để mình có thể copy những trường hợp tương tự qua 1 sheet khác, hoặc những nơi khác. Khi mà nơi đó chỉ cho nhập mỗi lần một số dòng giới hạn, như VD trên chỉ được nhập 4 dòng chẳng hạn.
Cảm ơn mọi người nhiều
Quên đi. Không giản dị như bạn nghĩ đâu.
 

0981858549

Thành viên mới
Tham gia
16/12/19
Bài viết
10
Được thích
1
Bạn thử chiêm nghiệm cái For . . . Next trước khi Do . . . Loop

PHP:
Sub CopyNhom4()
 Dim Rws As Long, J As Long, Col As Integer, NN As Integer
 Const CPy As Byte = 4
 Dim fRg As Range
 
 Rws = [C5].End(xlDown).Row
 Col = [C5].CurrentRegion.Columns.Count
 Set fRg = Cells(Rws + 4, "C")
 For J = 5 To Rws Step CPy
    Cells(J, "C").Resize(CPy, Col).Copy Destination:=fRg.Offset(NN + 4)
    NN = NN + CPy
 Next J
 MsgBox "Xong Rôi!"
End Sub
Cảm ơn bác nhiều, cũng là một cách hữu ích :)
 
Web KT

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL
Top Bottom