VBA Copy sheet theo thứ tự các cột paste nối tiếp nhau (1 người xem)

phamhau299 · 14/9/14

Mình có 1 sheet sobo từ ngày 1 đến ngày 31
và 1 sheet tổng hợp
mình muốn copy từ sheet sobo như sau:
Ngày 1: copy "line, mã, sum of 1" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 1 vào

copy xong ngày 1 sẽ copy tiếp ngày 2, paste bên dưới ngày 1

Ngày 2: copy "line, mã, sum of 2" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 2 vào
copy xong ngày 2 sẽ copy tiếp ngày 3, paste bên dưới ngày 2

Ngày 3: copy "line, mã, sum of 3" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 3 vào

nmhung49 · 14/9/14

phamhau299 đã viết:
Mình có 1 sheet sobo từ ngày 1 đến ngày 31
và 1 sheet tổng hợp
mình muốn copy từ sheet sobo như sau:
Ngày 1: copy "line, mã, sum of 1" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 1 vào

copy xong ngày 1 sẽ copy tiếp ngày 2, paste bên dưới ngày 1

Ngày 2: copy "line, mã, sum of 2" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 2 vào
copy xong ngày 2 sẽ copy tiếp ngày 3, paste bên dưới ngày 2

Ngày 3: copy "line, mã, sum of 3" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 3 vào

Thử code này
[GPECODE=vb]
Sub CopyGPE()

Dim i As Long

Sheets("tonghop").Range("C10:H6500").ClearContents

For i = 1 To 31

With Sheets("sobo")
.Range("A3:B8").Copy Sheets("tonghop").Range("D65000").End(xlUp).Offset(1)
.Range("A3").Offset(, 1 + i).Resize(6).Copy Sheets("tonghop").Range("H65000").End(xlUp).Offset(1)
Sheets("tonghop").Range("C65000").End(3).Offset(1).Resize(6).Value = i
End With
Next
End Sub

[/GPECODE]
Sau code đặt trong PHP bị lỗi mong BQT xem lại

Quang_Hải · 14/9/14

phamhau299 đã viết:
Mình có 1 sheet sobo từ ngày 1 đến ngày 31
và 1 sheet tổng hợp
mình muốn copy từ sheet sobo như sau:
Ngày 1: copy "line, mã, sum of 1" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 1 vào

copy xong ngày 1 sẽ copy tiếp ngày 2, paste bên dưới ngày 1

Ngày 2: copy "line, mã, sum of 2" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 2 vào
copy xong ngày 2 sẽ copy tiếp ngày 3, paste bên dưới ngày 2

Ngày 3: copy "line, mã, sum of 3" bên sheet sobo vào cột D, E, H bên sheet tonghop. Sau đó cột C bên sheet tonghop sẽ thêm số 3 vào

Thử code này

PHP:

Sub abc()
Dim data(), Res(), i As Long, j As Long, k As Long
data = Sheets("sobo").[a2].CurrentRegion.Value
ReDim Res(1 To UBound(data) * UBound(data, 2), 1 To 6)
For j = 3 To UBound(data, 2)
   For i = 2 To UBound(data)
      k = k + 1
      Res(k, 1) = j - 2
      Res(k, 2) = data(i, 1)
      Res(k, 3) = data(i, 2)
      Res(k, 6) = data(i, j)
   Next
Next
Sheets("tonghop").[C10].Resize(k, 6) = Res
End Sub

phamhau299 · 14/9/14

cảm ơn 2 bạn nhiều nha ^^

phamhau299 · 22/9/14

quanghai1969 đã viết:

Thử code này

PHP:

Sub abc()
Dim data(), Res(), i As Long, j As Long, k As Long
data = Sheets("sobo").[a2].CurrentRegion.Value
ReDim Res(1 To UBound(data) * UBound(data, 2), 1 To 6)
For j = 3 To UBound(data, 2)
   For i = 2 To UBound(data)
      k = k + 1
      Res(k, 1) = j - 2
      Res(k, 2) = data(i, 1)
      Res(k, 3) = data(i, 2)
      Res(k, 6) = data(i, j)
   Next
Next
Sheets("tonghop").[C10].Resize(k, 6) = Res
End Sub

cảm ơn code của bạn, nhưng bạn có thể sửa lại giúp mình là paste value được không
vì có nhiều mã chẳng hạn như: 8212130E90 chạy code paste qua nó thành 8.21E+96
82121E72 thành 8.21E+76...
và còn nhiều chuyền dạng như chuyền 1, chuyền 2 (dạng chữ), file sobo có công thức, nếu paste qua mà ko paste value thì nó thành số. đã sửa thành chữ nhưng các bước tiếp theo vẫn không thể dùng hàm vlookup dò tìm được vì chữ và số lẫn lộn
nên mình muốn là paste value qua chứ ko phải paste

Ba Tê · 23/9/14

phamhau299 đã viết:
cảm ơn code của bạn, nhưng bạn có thể sửa lại giúp mình là paste value được không
vì có nhiều mã chẳng hạn như: 8212130E90 chạy code paste qua nó thành 8.21E+96
82121E72 thành 8.21E+76...
và còn nhiều chuyền dạng như chuyền 1, chuyền 2 (dạng chữ), file sobo có công thức, nếu paste qua mà ko paste value thì nó thành số. đã sửa thành chữ nhưng các bước tiếp theo vẫn không thể dùng hàm vlookup dò tìm được vì chữ và số lẫn lộn
nên mình muốn là paste value qua chứ ko phải paste

Thử 3 cách:
1/ Format cột D,E dạng Text trước khi chạy code
2/ Hoặc Sửa 2 dòng này thành

PHP:

 Res(k, 2) = Format(data(i, 1), "@")
      Res(k, 3) = Format(data(i, 2), "@")

3/ Hoặc Sửa 2 dòng này thành

PHP:

Res(k, 2) = "'" & data(i, 1)
      Res(k, 3) = "'" & data(i, 2)

phamhau299 · 14/10/14

quanghai1969 đã viết:

Thử code này

PHP:

Sub abc()
Dim data(), Res(), i As Long, j As Long, k As Long
data = Sheets("sobo").[a2].CurrentRegion.Value
ReDim Res(1 To UBound(data) * UBound(data, 2), 1 To 6)
For j = 3 To UBound(data, 2)
   For i = 2 To UBound(data)
      k = k + 1
      Res(k, 1) = j - 2
      Res(k, 2) = data(i, 1)
      Res(k, 3) = data(i, 2)
      Res(k, 6) = data(i, j)
   Next
Next
Sheets("tonghop").[C10].Resize(k, 6) = Res
End Sub

Cho mình hỏi nếu chỉ copy số lượng > 0 thì sửa code lại như thế nào vậy bạn?

Ví dụ: sheet sobo

[TD="class: xl65, align: left"]LINE[/TD]
[TD="class: xl67, align: left"]MÃ[/TD]
[TD="class: xl66, align: left"]sum of 1[/TD]
[TD="class: xl66, align: left"] sum of 2[/TD]

[TD="align: left"]A1[/TD]
[TD="align: left"]25689A[/TD]
[TD="align: right"] 15
[/TD]
[TD="align: right"] 0[/TD]

[TD="align: left"]A2[/TD]
[TD="align: left"]72568A[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"] 2
[/TD]

[TD="align: left"]A10[/TD]
[TD="align: left"]5695F[/TD]
[TD="align: right"] 23
[/TD]
[TD="align: right"]0
[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

sum of 1:
chỉ copy A1 25689A 15
A10 5695F 23
sum of 2:
chỉ copy A2 72568A 2

KẾT QUẢ sheet tonghop sẽ được:

[TABLE="width: 64"]
[TR]
[TD="width: 64, align: left"][TABLE="width: 512"]
[TR]
[TD="width: 64, align: left"]Năm[/TD]
[TD="width: 64, align: left"]Tháng[/TD]
[TD="class: xl68, width: 64, align: left"]Ngày[/TD]
[TD="class: xl65, width: 64, align: left"]Line[/TD]
[TD="class: xl66, width: 64, align: left"]Mã[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="class: xl67, width: 64, align: left"]Số lượng[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD]A1[/TD]
[TD]25689A[/TD]
[TD][/TD]
[TD][/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD="class: xl69, width: 64"]A10[/TD]
[TD="class: xl69, width: 64"]5695F[/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl70, width: 64"]23[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[TD="class: xl69, width: 64"]A2[/TD]
[TD="class: xl69, width: 64"]72568A[/TD]
[TD="class: xl70, width: 64"][/TD]
[TD][/TD]
[TD]2[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[/TABLE]

Quang_Hải · 14/10/14

phamhau299 đã viết:
Cho mình hỏi nếu chỉ copy số lượng > 0 thì sửa code lại như thế nào vậy bạn?

Ví dụ: sheet sobo

[TD="class: xl65, align: left"]LINE[/TD]
[TD="class: xl67, align: left"]MÃ[/TD]
[TD="class: xl66, align: left"]sum of 1[/TD]
[TD="class: xl66, align: left"] sum of 2[/TD]

[TD="align: left"]A1[/TD]
[TD="align: left"]25689A[/TD]
[TD="align: right"] 15 [/TD]
[TD="align: right"] 0[/TD]

[TD="align: left"]A2[/TD]
[TD="align: left"]72568A[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"] 2 [/TD]

[TD="align: left"]A10[/TD]
[TD="align: left"]5695F[/TD]
[TD="align: right"] 23 [/TD]
[TD="align: right"]0[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

sum of 1:
chỉ copy A1 25689A 15
A10 5695F 23
sum of 2:
chỉ copy A2 72568A 2

KẾT QUẢ sheet tonghop sẽ được:

[TABLE="width: 64"]
[TR]
[TD="width: 64, align: left"][TABLE="width: 512"]
[TR]
[TD="width: 64, align: left"]Năm[/TD]
[TD="width: 64, align: left"]Tháng[/TD]
[TD="class: xl68, width: 64, align: left"]Ngày[/TD]
[TD="class: xl65, width: 64, align: left"]Line[/TD]
[TD="class: xl66, width: 64, align: left"]Mã[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="class: xl67, width: 64, align: left"]Số lượng[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD]A1[/TD]
[TD]25689A[/TD]
[TD][/TD]
[TD][/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD="class: xl69, width: 64"]A10[/TD]
[TD="class: xl69, width: 64"]5695F[/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl70, width: 64"]23[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[TD="class: xl69, width: 64"]A2[/TD]
[TD="class: xl69, width: 64"]72568A[/TD]
[TD="class: xl70, width: 64"][/TD]
[TD][/TD]
[TD]2[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[/TABLE]

PHP:

Sub abc()
Dim data(), Res(), i As Long, j As Long, k As Long
data = Sheets("sobo").[a2].CurrentRegion.Value
ReDim Res(1 To UBound(data) * UBound(data, 2), 1 To 6)
For j = 3 To UBound(data, 2)
   For i = 2 To UBound(data)
      If data(i, j) > 0 Then
         k = k + 1
         Res(k, 1) = j - 2
         Res(k, 2) = data(i, 1)
         Res(k, 3) = data(i, 2)
         Res(k, 6) = data(i, j)
      End If
   Next
Next
Sheets("tonghop").[C10].Resize(k, 6) = Res
End Sub

phamhau299 · 16/10/14

quanghai1969 đã viết:

PHP:

Sub abc()
Dim data(), Res(), i As Long, j As Long, k As Long
data = Sheets("sobo").[a2].CurrentRegion.Value
ReDim Res(1 To UBound(data) * UBound(data, 2), 1 To 6)
For j = 3 To UBound(data, 2)
   For i = 2 To UBound(data)
      If data(i, j) > 0 Then
         k = k + 1
         Res(k, 1) = j - 2
         Res(k, 2) = data(i, 1)
         Res(k, 3) = data(i, 2)
         Res(k, 6) = data(i, j)
      End If
   Next
Next
Sheets("tonghop").[C10].Resize(k, 6) = Res
End Sub

Mình đang gặp rắc rối khi phát sinh thêm 2 xưởng nữa
bạn có thể giúp mình vấn đề này:
Sếp bắt mình làm tổng hợp thêm 2 xưởng nữa
và dữ liệu người ta gửi cho mình theo form mới, line, mã sp cũng dạng mới
nên phát sinh thêm vài vấn đề:
1 sheet tonghop, 3 sheet con (soboda, sobomp, sobotv)

Sheet tonghop:
Cột: Tháng: lấy bên sheet sobo...
Cột: Ngày: copy ngày nào thì đánh ngày đó
Cột: Line: không có ca, định dạng text (bên sheet sobo có 2 ca)
Cột: Mã sp: không có dấu gạch giữa, định dạng text (bên sheet sobo có gạch giữa)
Cột: Số bộ: Cùng 1 ngày, Cùng 1 mã sp, cùng 1 line nhưng 2 ca thì cộng lại
cùng 1 ngày, cùng 1 mã sp, 1 line, 1 ca thì giữ nguyên
cùng 1 ngày, 1 mã sp , 2 line sx thì cộng theo line đó
Cột: Xưởng+Ngày: dữ liệu copy từ soboda: "DA" + ngày
dữ liệu copy từ sobomp: "MP" + ngày
dữ liệu copy từ sobotv: "TV" + ngày

(cột Xưởng+ ngày là để sếp sẽ thử lại bằng cách sum xưởng bất kỳ + ngày bất kỳ, nếu kết quả giống với bên sheet sobo... là ok)

Bên 3 sheet sobo...:cột A (ID) không quan tâm
chỉ copy từ cột B (Thang) trở về sau...

nếu làm thủ công thì mình dùng hàm xử lý line, mã sp rồi Pivot table, sau đó copy qua sheet tonghop, nên rất lâu
mình gà VBA nên hỏi hoài cũng ngại ghê
mong bạn giúp mình vấn đề này để khối lượng công việc trong công ty giảm bớt

http://www.mediafire.com/download/xq7jg7sl99civm7/TONGHOP+MOI.xlsx

VBA Copy sheet theo thứ tự các cột paste nối tiếp nhau (1 người xem)

Người dùng đang xem chủ đề này

phamhau299

Thành viên mới

File đính kèm

nmhung49

Thành viên tích cực

Quang_Hải

Thành viên gạo cội

phamhau299

Thành viên mới

phamhau299

Thành viên mới

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

phamhau299

Thành viên mới

Quang_Hải

Thành viên gạo cội

phamhau299

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.