nhờ xem giúp code nối data từ nhiều sheet thành 1 sheet

[ketoan113]

em chào các bác
em có học code vba trên mạng, nối data từ nhiều sheet thành 1 sheet
tuy nhiên code chạy bị lỗi, data tổng hợp ở sheet tổng hợp bị chạy lập lại
em nhờ các bác xem sửa code giúp em với

em cảm ơn nhiều

 

[anhtuan2939]

Bạn thử code này xem

Sub tonghop()
    Dim lst&, lr&
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    Sheets("Tong hop").Range("A9:M10000").ClearContents
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Tong hop" And ws.Name <> "Nganh" Then
            lr = Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            lst = ws.Range("B" & Rows.Count).End(xlUp).Row
            
            Sheets("Tong hop").Range("A" & lr & ":M" & lst + lr - 9).Value = ws.Range("A9:M" & lst).Value
        End If
        
    Next ws
    
    Application.ScreenUpdating = True
End Sub

 

[ketoan113]

Bạn thử code này xem

Sub tonghop()
    Dim lst&, lr&
    Dim ws As Worksheet
   
    Application.ScreenUpdating = False
   
    Sheets("Tong hop").Range("A9:M10000").ClearContents
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Tong hop" And ws.Name <> "Nganh" Then
            lr = Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            lst = ws.Range("B" & Rows.Count).End(xlUp).Row
           
            Sheets("Tong hop").Range("A" & lr & ":M" & lst + lr - 9).Value = ws.Range("A9:M" & lst).Value
        End If
       
    Next ws
   
    Application.ScreenUpdating = True
End Sub

trước hết em cảm ơn bác anhtuan2939

em nhờ bác chỉnh giúp em 1 vài chỗ với

1.
Sheets("Tong hop").Range("A9:M10000").ClearContents

bác có thể viết dùm em delete từ row 9 đến 10000 không, thay vì clearcontents

2. Khi copy data từ các sheet về sheet tổng hợp thì copy paste thôi, ko paste value

em cảm ơn nhiều ạ

 

[anhtuan2939]

trước hết em cảm ơn bác anhtuan2939

em nhờ bác chỉnh giúp em 1 vài chỗ với

1.
Sheets("Tong hop").Range("A9:M10000").ClearContents

bác có thể viết dùm em delete từ row 9 đến 10000 không, thay vì clearcontents

2. Khi copy data từ các sheet về sheet tổng hợp thì copy paste thôi, ko paste value

em cảm ơn nhiều ạ

Bạn thử lại xem

Sub tonghop()
    Dim lst&, lr&
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Sheets("Tong hop").Rows("9:100000").Delete
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Tong hop" And ws.Name <> "Nganh" Then
            lr = Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            lst = ws.Range("B" & Rows.Count).End(xlUp).Row
            
            If lst >= 9 Then ws.Range("A9:M" & lst).Copy Destination:=Sheets("Tong hop").Range("A" & lr)
        End If
        
    Next ws
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[ketoan113]

Bạn thử lại xem

Sub tonghop()
    Dim lst&, lr&
    Dim ws As Worksheet
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    Sheets("Tong hop").Rows("9:100000").Delete
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Tong hop" And ws.Name <> "Nganh" Then
            lr = Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            lst = ws.Range("B" & Rows.Count).End(xlUp).Row
          
            If lst >= 9 Then ws.Range("A9:M" & lst).Copy Destination:=Sheets("Tong hop").Range("A" & lr)
        End If
      
    Next ws
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

ôi đúng y như mong muốn của em
e chân thành cảm ơn bác, chúc bác nhiều sức khoẻ và mọi việc tốt lành ạ

 

[ketoan113]

Bạn thử lại xem

Sub tonghop()
    Dim lst&, lr&
    Dim ws As Worksheet
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    Sheets("Tong hop").Rows("9:100000").Delete
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Tong hop" And ws.Name <> "Nganh" Then
            lr = Sheets("Tong hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            lst = ws.Range("B" & Rows.Count).End(xlUp).Row
          
            If lst >= 9 Then ws.Range("A9:M" & lst).Copy Destination:=Sheets("Tong hop").Range("A" & lr)
        End If
      
    Next ws
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

bác anhtuan2939 ơi,

code qua bác viết dùm em ok quá rồi

có 1 chỗ là em có code filter tên loccp_td cũng ok rồi (code này em được người khác viết giúp)

nhưng bác cải tiến dùm em khi em gõ điều kiện vào ô B3, em bấm enter nó ra kết quả luôn không ạ, e khỏi phải bấm chạy tìm cp mất time
bác coi trong file em đính kèm nhé,

tks bác

 

[TongDe]

Dựa theo code của anhtuan2939, góp vui thêm đoạn code nhỏ cho sự kiện Worksheet_Change để lọc theo mã...
Click chọn trong cell B3

 

[ketoan113]

Dựa theo code của anhtuan2939, góp vui thêm đoạn code nhỏ cho sự kiện Worksheet_Change để lọc theo mã...
Click chọn trong cell B3

trước hết em cảm ơn bác Đệ
nhưng em thấy có mấy chỗ bác coi sửa dùm em với
1.
code của bác anhtuan2939 tổng hợp data về sheet tổng hợp bác ấy copy paste thôi, bác paste value mất code của bác ây rồi.
2.
Trình tự là em có 1 cái data sheet tổng hợp, sau khi có data em mới gõ mã CK nào em quan tâm vào để filter thôi, ý là 2 việc độc lập ý. Tổng hợp 1 code, filter 1 code
3.
sao tại ô B3 nó có cái list danh sách vậy bác? nếu để vậy thì mã em gõ nó không có trong danh sách thì em ko gõ được , nó bị hạn chế á, bác coi sửa dùm dc em ko ạ?

em cảm ơn bác

 

[TongDe]

trước hết em cảm ơn bác Đệ
nhưng em thấy có mấy chỗ bác coi sửa dùm em với
1.
code của bác anhtuan2939 tổng hợp data về sheet tổng hợp bác ấy copy paste thôi, bác paste value mất code của bác ây rồi.
2.
Trình tự là em có 1 cái data sheet tổng hợp, sau khi có data em mới gõ mã CK nào em quan tâm vào để filter thôi, ý là 2 việc độc lập ý. Tổng hợp 1 code, filter 1 code
3.
sao tại ô B3 nó có cái list danh sách vậy bác? nếu để vậy thì mã em gõ nó không có trong danh sách thì em ko gõ được , nó bị hạn chế á, bác coi sửa dùm dc em ko ạ?

em cảm ơn bác

1+2: Sheet Tong Hop unhide vẫn còn đấy...
3: Danh sách đó là lấy sheet Nganh thì sao lại không có, chắc tại sort theo ABC nên bạn không thấy thôi, bạn sort lại theo STT để đưa mã ưu tiên lên đầu danh sách.
Muốn bỏ hộp chọn , vào data validation, clear all...

 

[ketoan113]

1+2: Sheet Tong Hop unhide vẫn còn đấy...
3: Danh sách đó là lấy sheet Nganh thì sao lại không có, chắc tại sort theo ABC nên bạn không thấy thôi, bạn sort lại theo STT để đưa mã ưu tiên lên đầu danh sách.
Muốn bỏ hộp chọn , vào data validation, clear all...

cám ơn bác

bác có thể viết dùm code để em lọc trực tiếp trên sheet tổng hợp luôn duoc ko bác?

(ý em là em chạy code tổng hợp là 1 code, code filter mã CK là 1 code)

bác làm vậy là thêm sheet mới rồi, vì có sheet tổng hợp rồi thì làm trên sheet tổng hợp luôn chứ thêm sheet mới làm chi ạ

tks bác

 

[anhtuan2939]

nhưng bác cải tiến dùm em khi em gõ điều kiện vào ô B3, em bấm enter nó ra kết quả luôn không ạ, e khỏi phải bấm chạy tìm cp mất time
bác coi trong file em đính kèm nhé

Bạn thêm code này phần nhập code của sheet Tong hop

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long
    
    If Not Intersect(Target, Range("B3")) Is Nothing Then
        lr = Range("B" & Rows.Count).End(xlUp).Row
        Range("A8:O" & lr).AutoFilter Field:=2, Criteria1:=Split(Target, ","), Operator:=xlFilterValues
    End If
End Sub

 

[ketoan113]

Bạn thêm code này phần nhập code của sheet Tong hop

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long
 
    If Not Intersect(Target, Range("B3")) Is Nothing Then
        lr = Range("B" & Rows.Count).End(xlUp).Row
        Range("A8:O" & lr).AutoFilter Field:=2, Criteria1:=Split(Target, ","), Operator:=xlFilterValues
    End If
End Sub

ôi thật tuyệt vời, em cảm ơn bác anhtuan2939 nhiều ạ
(vba giúp tiết kiệm biết bao nhiêu thời gian để xử lý data, thật tuyệt)