Giúp đỡ code copy từ nhiều sheet về một sheet tổng hợp và xoá nội dung cũ

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Xin chào các AC và các Bạn trên GPE,
Mình có một vấn đề này cần nhờ mọi người hỗ trợ giúp:

Mình có 01 file gồm nhiều sheet, trong đó có các sheet nhập liệu như CanTho, vungTau...và sheet Master dùng để tổng hợp dữ liệu từ các sheet khác. Yêu cầu như sau:
- Việc nhập liệu sẽ diễn ra thường xuyên và được phân chia cho từng khu vực riêng biệt như Cần Thơ, vũng Tàu...
- Cuối ngày mình sẽ tổng hợp bằng cách nhấn "Cập nhật" bên sheet Master thì các dữ liệu được copy tự động từ các sheet con về sheet master
- Dữ liệu cũ trong các sheet con sẽ được xoá trắng để nhằm phục vụ cho các ngày tiếp sau đó
- Dữ liệu trong sheet master sẽ được cập nhật liên tục mỗi cuối ngày (lưu ý là dữ liệu mới không đè mất dữ liệu cũ nha)

Mìn gửi file mẫu đính kèm. Rất mong các AC và các Bạn hỗ trợ giúp.
Xin cám ơn nhiều
 

File đính kèm

hpkhuong

######
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,624
Được thích
4,080
Điểm
560
Nơi ở
Quận 2 - TP.HCM
Bạn chạy code sau

Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 4), I As Long, J As Long, K As Long, Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "Master" Then
        Arr = Ws.Range("B2", Ws.Range("B2").End(4)).Resize(, 3).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row() - 1"
            For J = 1 To 3
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A2", Ws.Range("A2").End(4)).Resize(, 4).Value = Empty
    End If
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 4).Value = dArr
End With
End Sub
 

Kiều Mạnh

Thành viên gạo cội
Tham gia ngày
9 Tháng sáu 2012
Bài viết
3,918
Được thích
2,719
Điểm
560
Nơi ở
IIIIIIIIIIIIIIIII
Xin chào các AC và các Bạn trên GPE,
Mình có một vấn đề này cần nhờ mọi người hỗ trợ giúp:

Mình có 01 file gồm nhiều sheet, trong đó có các sheet nhập liệu như CanTho, vungTau...và sheet Master dùng để tổng hợp dữ liệu từ các sheet khác. Yêu cầu như sau:
- Việc nhập liệu sẽ diễn ra thường xuyên và được phân chia cho từng khu vực riêng biệt như Cần Thơ, vũng Tàu...
- Cuối ngày mình sẽ tổng hợp bằng cách nhấn "Cập nhật" bên sheet Master thì các dữ liệu được copy tự động từ các sheet con về sheet master
- Dữ liệu cũ trong các sheet con sẽ được xoá trắng để nhằm phục vụ cho các ngày tiếp sau đó
- Dữ liệu trong sheet master sẽ được cập nhật liên tục mỗi cuối ngày (lưu ý là dữ liệu mới không đè mất dữ liệu cũ nha)

Mìn gửi file mẫu đính kèm. Rất mong các AC và các Bạn hỗ trợ giúp.
Xin cám ơn nhiều
Thử code sau xem sao ... --=0
Mã:
Sub TongHopSheets()
Dim Sh As Worksheet
For Each Sh In Worksheets
   If Sh.CodeName <> "Sheet3" Then
      Sh.Range("A2", Sh.[A65536].End(3).Resize(, 4)).Copy Sheet3.[A65536].End(3)(2)
      Sh.Range("A2", Sh.[A65536].End(3).Resize(, 4)).ClearContents
   End If
Next
End Sub
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Các ơn mọi người nhiều dù chưa thử code xem thế nào do đang lỡ tay chút, cứ Cảm ơn trước cái đã. Khi thử có gì khó khăn sẽ nhờ mọi người hỗ trợ tiếp
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Cám ơn Bạn đã hỗ trợ, code chạy rất đúng ý đồ như file demo đã gửi. Nhưng còn vấn đề này nhờ bạn hỗ trợ thêm giúp:
- trong file có nhiều sheet, và chỉ copy từ vài sheet vào một sheet "master" mà thôi. ở đây mình ví dụ là sheet "CanTho" và "VungTau". các sheet khác không liên quan
- dữ liệu được bố trí trên nhiều cột

Mình gửi file đính kèm, nhờ bạn hỗ trợ mình với.

cám ơn Bạn nhiều
 

File đính kèm

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Thử code sau xem sao ... --=0
Mã:
Sub TongHopSheets()
Dim Sh As Worksheet
For Each Sh In Worksheets
   If Sh.CodeName <> "Sheet3" Then
      Sh.Range("A2", Sh.[A65536].End(3).Resize(, 4)).Copy Sheet3.[A65536].End(3)(2)
      Sh.Range("A2", Sh.[A65536].End(3).Resize(, 4)).ClearContents
   End If
Next
End Sub

code của bạn mình đã thử thì phát đầu tiên copy rất ok, nhưng lỡ phát sau có bấm tiếp mà bên sheet nhập liệu chưa có gì mới thì nó "chơi luôn" cái dòng tiêu đề. Nhờ Bạn check thêm giúp với. Nếu được nhờ Bạn nghiên cứu file đính kèm mình gửi thêm với vài yêu cầu chi tiết hơn.

cám ơn Bạn nhiều
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Bạn chạy code sau

Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 4), I As Long, J As Long, K As Long, Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "Master" Then
        Arr = Ws.Range("B2", Ws.Range("B2").End(4)).Resize(, 3).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row() - 1"
            For J = 1 To 3
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A2", Ws.Range("A2").End(4)).Resize(, 4).Value = Empty
    End If
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 4).Value = dArr
End With
End Sub
Cám ơn Bạn đã hỗ trợ, code chạy rất đúng ý đồ như file demo đã gửi. Nhưng còn vấn đề này nhờ bạn hỗ trợ thêm giúp:
- trong file có nhiều sheet, và chỉ copy từ vài sheet vào một sheet "master" mà thôi. ở đây mình ví dụ là sheet "CanTho" và "VungTau". các sheet khác không liên quan
- dữ liệu được bố trí trên nhiều cột

Mình gửi file đính kèm, nhờ bạn hỗ trợ mình với.

cám ơn Bạn nhiều
 

File đính kèm

Kiều Mạnh

Thành viên gạo cội
Tham gia ngày
9 Tháng sáu 2012
Bài viết
3,918
Được thích
2,719
Điểm
560
Nơi ở
IIIIIIIIIIIIIIIII
code của bạn mình đã thử thì phát đầu tiên copy rất ok, nhưng lỡ phát sau có bấm tiếp mà bên sheet nhập liệu chưa có gì mới thì nó "chơi luôn" cái dòng tiêu đề. Nhờ Bạn check thêm giúp với. Nếu được nhờ Bạn nghiên cứu file đính kèm mình gửi thêm với vài yêu cầu chi tiết hơn.

cám ơn Bạn nhiều
vấn đề là nó chơi cái dòng to màu đỏ không quan trong ... chuyện như con thỏ....
quan trong 3 hồi thế nọ 3 hồi thế kia nên làm biếng thôi mà ....Anh bài #2 ý ...Anh đó siêu trị cái món này lắm đó...--=0--=0
 

hpkhuong

######
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,624
Được thích
4,080
Điểm
560
Nơi ở
Quận 2 - TP.HCM
Cám ơn Bạn đã hỗ trợ, code chạy rất đúng ý đồ như file demo đã gửi. Nhưng còn vấn đề này nhờ bạn hỗ trợ thêm giúp:
- trong file có nhiều sheet, và chỉ copy từ vài sheet vào một sheet "master" mà thôi. ở đây mình ví dụ là sheet "CanTho" và "VungTau". các sheet khác không liên quan
- dữ liệu được bố trí trên nhiều cột
Mình gửi file đính kèm, nhờ bạn hỗ trợ mình với.
cám ơn Bạn nhiều
Bạn xem lại file của bạn xem.
Sheet Master thì cả rừng cột
Hai sheet kia thì ....tiêu đề cột tương tự sheet Master đâu?

Muốn gì cũng phải rõ ràng chứ nhỉ? Bạn nói vậy ai biết bạn lấy từ cột nào tới cột nào...mà bảo nhiều cột???
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Bạn xem lại file của bạn xem.
Sheet Master thì cả rừng cột
Hai sheet kia thì ....tiêu đề cột tương tự sheet Master đâu?

Muốn gì cũng phải rõ ràng chứ nhỉ? Bạn nói vậy ai biết bạn lấy từ cột nào tới cột nào...mà bảo nhiều cột???
Sorry Bạn và mọi người, mình gửi nhầm file vì ban đầu dự định chỉ copy vài cột cơ bản cho file tổng đỡ nặng thôi. Mình gửi lại file, các sheet nhập liệu đều giống nhau về format . Mình cần copy dữ liệu từ cột A--> T nha, copy từ sheet "CanTho" và "VungTau" vào sheet "Master". Sau khi copy thì tự xoá nội dung cũ trong các sheet con để phục vụ cho các ngày tiếp theo sau. Nhờ Bạn hỗ trợ giúp nha

Cám ơn Bạn trước
 

File đính kèm

hpkhuong

######
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,624
Được thích
4,080
Điểm
560
Nơi ở
Quận 2 - TP.HCM
Sorry Bạn và mọi người, mình gửi nhầm file vì ban đầu dự định chỉ copy vài cột cơ bản cho file tổng đỡ nặng thôi. Mình gửi lại file, các sheet nhập liệu đều giống nhau về format . Mình cần copy dữ liệu từ cột A--> T nha, copy từ sheet "CanTho" và "VungTau" vào sheet "Master". Sau khi copy thì tự xoá nội dung cũ trong các sheet con để phục vụ cho các ngày tiếp theo sau. Nhờ Bạn hỗ trợ giúp nha

Cám ơn Bạn trước
Phía sau dòng có dữ liệu của 3 sheet ấy...bạn gõ cái gì mà giới hạn, giới hạn...tùm lum vậy. Phải xóa hết,.. gõ tới đâu thì copy tới đó. Chứ bạn giới hạn xa vậy...code nào chịu nổi

Xóa hết đi ròi up file lên tính tiếp...
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Phía sau dòng có dữ liệu của 3 sheet ấy...bạn gõ cái gì mà giới hạn, giới hạn...tùm lum vậy. Phải xóa hết,.. gõ tới đâu thì copy tới đó. Chứ bạn giới hạn xa vậy...code nào chịu nổi

Xóa hết đi ròi up file lên tính tiếp...
Bạn ơi, mình gửi lại file mà sao giới hạn tải lên hình như không đủ nên up file không cho

Nếu được nhờ bạn delete các dòng giới hạn đó giúp mình được không vì nó chỉ là dòng tô màu cảnh báo không cho nhập vượt giới hạn thôi hà
 

hpkhuong

######
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,624
Được thích
4,080
Điểm
560
Nơi ở
Quận 2 - TP.HCM
Bạn ơi, mình gửi lại file mà sao giới hạn tải lên hình như không đủ nên up file không cho

Nếu được nhờ bạn delete các dòng giới hạn đó giúp mình được không vì nó chỉ là dòng tô màu cảnh báo không cho nhập vượt giới hạn thôi hà
Bạn xóa sheet Master đi. Sau đó insert 1 sheet mới và đặt lại tên là Master, copy tiêu đề cho nó. Sau đó chạy code sau
P/s: Không hiểu sao sheet Master trên file của bạn không thể chạy được code nên bạn phải xóa và tạo lại thì chạy được...

Và tất nhiên như tôi nói thì bạn phải tự xóa mấy dòng linh tinh giới hạn file gì đó ở các sheet kia mới chạy code được nha. Tới đây thì bạn tự thân vận động được rồi đấy...tôi không tham gia thêm nữa!
Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 20), I As Long, J As Long
Dim K As Long, Ws As Worksheet, sArr, X As Long
sArr = Array("CanTho", "VungTau")
For Each Ws In Worksheets
    For X = 0 To UBound(sArr)
    If Ws.Name = sArr(X) Then
        Arr = Ws.Range("B4", Ws.Range("B4").End(4)).Resize(, 19).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row()-3"
            For J = 1 To 19
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A4:T" & Ws.Range("B4").End(4).Row).Value = Empty
    End If
    Next X
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 20).Value = dArr
End With
End Sub
 

Kiều Mạnh

Thành viên gạo cội
Tham gia ngày
9 Tháng sáu 2012
Bài viết
3,918
Được thích
2,719
Điểm
560
Nơi ở
IIIIIIIIIIIIIIIII
Bạn xóa sheet Master đi. Sau đó insert 1 sheet mới và đặt lại tên là Master, copy tiêu đề cho nó. Sau đó chạy code sau
P/s: Không hiểu sao sheet Master trên file của bạn không thể chạy được code nên bạn phải xóa và tạo lại thì chạy được...

Và tất nhiên như tôi nói thì bạn phải tự xóa mấy dòng linh tinh giới hạn file gì đó ở các sheet kia mới chạy code được nha. Tới đây thì bạn tự thân vận động được rồi đấy...tôi không tham gia thêm nữa!
Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 20), I As Long, J As Long
Dim K As Long, Ws As Worksheet, sArr, X As Long
sArr = Array("CanTho", "VungTau")
For Each Ws In Worksheets
    For X = 0 To UBound(sArr)
    If Ws.Name = sArr(X) Then
        Arr = Ws.Range("B4", Ws.Range("B4").End(4)).Resize(, 19).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row()-3"
            For J = 1 To 19
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A4:T" & Ws.Range("B4").End(4).Row).Value = Empty
    End If
    Next X
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 20).Value = dArr
End With
End Sub
đang vui mà sao Thôi sớm vậy chứ ...--=0--=0--=0
 

trungpp

Thành viên mới
Tham gia ngày
16 Tháng mười 2009
Bài viết
37
Được thích
1
Điểm
353
Bạn xóa sheet Master đi. Sau đó insert 1 sheet mới và đặt lại tên là Master, copy tiêu đề cho nó. Sau đó chạy code sau
P/s: Không hiểu sao sheet Master trên file của bạn không thể chạy được code nên bạn phải xóa và tạo lại thì chạy được...

Và tất nhiên như tôi nói thì bạn phải tự xóa mấy dòng linh tinh giới hạn file gì đó ở các sheet kia mới chạy code được nha. Tới đây thì bạn tự thân vận động được rồi đấy...tôi không tham gia thêm nữa!
Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 20), I As Long, J As Long
Dim K As Long, Ws As Worksheet, sArr, X As Long
sArr = Array("CanTho", "VungTau")
For Each Ws In Worksheets
    For X = 0 To UBound(sArr)
    If Ws.Name = sArr(X) Then
        Arr = Ws.Range("B4", Ws.Range("B4").End(4)).Resize(, 19).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row()-3"
            For J = 1 To 19
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A4:T" & Ws.Range("B4").End(4).Row).Value = Empty
    End If
    Next X
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 20).Value = dArr
End With
End Sub

OK cám ơn bạn nhiều, đoạn sau để mình tự xào nấu vậy
 

BALLOONNEVERBUM

Thành viên mới
Tham gia ngày
14 Tháng mười 2010
Bài viết
15
Được thích
3
Điểm
365
Tuổi
33
Bạn xóa sheet Master đi. Sau đó insert 1 sheet mới và đặt lại tên là Master, copy tiêu đề cho nó. Sau đó chạy code sau
P/s: Không hiểu sao sheet Master trên file của bạn không thể chạy được code nên bạn phải xóa và tạo lại thì chạy được...

Và tất nhiên như tôi nói thì bạn phải tự xóa mấy dòng linh tinh giới hạn file gì đó ở các sheet kia mới chạy code được nha. Tới đây thì bạn tự thân vận động được rồi đấy...tôi không tham gia thêm nữa!
Mã:
Public Sub GPE()
Dim Arr, dArr(1 To 65000, 1 To 20), I As Long, J As Long
Dim K As Long, Ws As Worksheet, sArr, X As Long
sArr = Array("CanTho", "VungTau")
For Each Ws In Worksheets
    For X = 0 To UBound(sArr)
    If Ws.Name = sArr(X) Then
        Arr = Ws.Range("B4", Ws.Range("B4").End(4)).Resize(, 19).Value
        For I = 1 To UBound(Arr)
            K = K + 1
            dArr(K, 1) = "=Row()-3"
            For J = 1 To 19
                dArr(K, J + 1) = Arr(I, J)
            Next J
        Next I
        Ws.Range("A4:T" & Ws.Range("B4").End(4).Row).Value = Empty
    End If
    Next X
Next Ws
With Sheets("Master")
    .Range("A65000").End(3).Offset(1).Resize(K, 20).Value = dArr
End With
End Sub

Em đang có nhu cầu tương tự, chỉ khác là em không cần xóa dữ liệu 2 sheet cũ sau khi tổng hợp. Anh có thể chỉ thêm cho em được không ạ? Em có đăng bài lên diễn đàn, mong anh xem giúp:
 
Top Bottom