Code copy dữ liệu Sheet này bỏ vào shet khác theo thứ tự các cột (2 người xem)

[phamhau299]

mình có 4 sheet dữ liệu và 1 sheet BAOCAO
mình muốn copy 4 sheet vào sheet BAOCAO
copy xong sheet này sẽ copy tiếp sheet khác paste nối tiếp nhau vào sheet BAOCAO
sheet BAOCAO: CỘT F, C, J, M, P, Q, R, T
tương ứng với 4 sheet:
SXTT1: CỘT X, Y, Z, AA, AB, AC, AD, AE
SXTT2 :CỘT X, Y, Z, AA, AB, AC, AD, AE
QATT1:CỘT X, Y, Z, AA, AB, AC, AD, AE
QATT2: CỘT X, Y, Z, AA, AB, AC, AD, AE

 

[nghiaphuc]

mình có 4 sheet dữ liệu và 1 sheet BAOCAO
mình muốn copy 4 sheet vào sheet BAOCAO
copy xong sheet này sẽ copy tiếp sheet khác paste nối tiếp nhau vào sheet BAOCAO
sheet BAOCAO: CỘT F, C, J, M, P, Q, R, T
tương ứng với 4 sheet:
SXTT1: CỘT X, Y, Z, AA, AB, AC, AD, AE
SXTT2 :CỘT X, Y, Z, AA, AB, AC, AD, AE
QATT1:CỘT X, Y, Z, AA, AB, AC, AD, AE
QATT2: CỘT X, Y, Z, AA, AB, AC, AD, AE

Bạn gõ mấy chữ GPE vào các ô tương ứng trên hàng 9 của sheet BAOCAO (trên các cột F, C, J, M, P, Q, R, T) rồi chạy code này:
[GPECODE=vb]Sub CopyDL()
Dim i As Long, ShArr
ShArr = Array("SXTT1", "SXTT2", "QATT1", "QATT2")
For i = 0 To 3
Sheets("BAOCAO").[F65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[X2:X1001].Value
Sheets("BAOCAO").[C65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[Y2:Y1001].Value
Sheets("BAOCAO").[J65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[Z2:Z1001].Value
Sheets("BAOCAO").[M65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AA2:AA1001].Value
Sheets("BAOCAO").[P65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AB2:AB1001].Value
Sheets("BAOCAO").[Q65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AC2:AC1001].Value
Sheets("BAOCAO").[R65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AD2:AD1001].Value
Sheets("BAOCAO").[T65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AE2:AE1001].Value
Next
End Sub[/GPECODE]
Vì các cột trên sheet BAOCAO cách quãng và không có quy luật nên đành chấp nhận dài dòng vậy, nếu copy cỡ vài trăm dòng theo kiểu này chắc chết quá.

Điều kiện để code chạy đúng: Các cột X:AE trên 4 sheet con phải được điền đầy đủ thông tin, ít nhất là đối với hàng cuối cùng.

 

[VetMini]

...Vì các cột trên sheet BAOCAO cách quãng và không có quy luật nên đành chấp nhận dài dòng vậy, nếu copy cỡ vài trăm dòng theo kiểu này chắc chết quá.
....

Không hẳn vậy đâu. Tại bạn quen truy cập range theo kiểu dùng hàm Evaluate ( [A1] ) cho nên bạn quên mất cách sử dụng range theo địa chỉ, có thể dùng vòng lặp để thực hiện trên array

cDes = Split("F,C,J,M,P,Q,R,T", ",")
cSrc = Split("X,Y,Z,AA,AB,AC,AD,AE", ",")
...
For col = 0 to 7
Sheets("BAOCAO").Range(cDes(col) & "65000").End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).Range(cSrc(col) & "2:" & cSrc(col) & "1001").Value

 

[phamhau299]

Bạn gõ mấy chữ GPE vào các ô tương ứng trên hàng 9 của sheet BAOCAO (trên các cột F, C, J, M, P, Q, R, T) rồi chạy code này:
[GPECODE=vb]Sub CopyDL()
Dim i As Long, ShArr
ShArr = Array("SXTT1", "SXTT2", "QATT1", "QATT2")
For i = 0 To 3
Sheets("BAOCAO").[F65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[X2:X1001].Value
Sheets("BAOCAO").[C65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[Y2:Y1001].Value
Sheets("BAOCAO").[J65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[Z2:Z1001].Value
Sheets("BAOCAO").[M65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AA2:AA1001].Value
Sheets("BAOCAO").[P65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AB2:AB1001].Value
Sheets("BAOCAO").[Q65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AC2:AC1001].Value
Sheets("BAOCAO").[R65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AD2:AD1001].Value
Sheets("BAOCAO").[T65000].End(xlUp).Offset(1).Resize(1000).Value = Sheets(ShArr(i)).[AE2:AE1001].Value
Next
End Sub[/GPECODE]
Vì các cột trên sheet BAOCAO cách quãng và không có quy luật nên đành chấp nhận dài dòng vậy, nếu copy cỡ vài trăm dòng theo kiểu này chắc chết quá.

Điều kiện để code chạy đúng: Các cột X:AE trên 4 sheet con phải được điền đầy đủ thông tin, ít nhất là đối với hàng cuối cùng.

cảm ơn bạn, mình đã chạy được
nhưng 4 sheet dữ liệu của mình, mỗi sheet có khoảng trên 1000 dòng, vậy mình phải sửa lại như thế nào để chạy đầy đủ

 

[nghiaphuc]

cảm ơn bạn, mình đã chạy được
nhưng 4 sheet dữ liệu của mình, mỗi sheet có khoảng trên 1000 dòng, vậy mình phải sửa lại như thế nào để chạy đầy đủ

Trong code trên của tôi, bạn sửa con số 1000 (trong chỗ Resize(1000)) thành 1 con số lớn hơn và con số 1001 ở gần cuối mỗi câu lệnh thay bằng con số mới của bạn cộng với 1. Chẳng hạn sửa 1000 thành 9999, 1001 thành 10000,...