Xin trợ giúp sửa lỗi Code tách dữ liệu ra nhiều sheet

[thanhnam0119]

Xin chào các anh chị trong diễn đàn ạ!
Em có một file khi chạy code báo lỗi phần "ws.Name = cel.Value"
Nhờ anh chị giúp em xử lý lỗi và khi em tách sheet tính luôn tổng chân của các sheet ạ! em cảm ơn anh chị nhiều

Sub tach()
Sheet1.Activate
Dim lr As Long
Dim rng As Range, cel As Range
Dim ws As Worksheet
lr = Range("h" & Rows.Count).End(xlUp).Row
Set rng = Range("a1:g" & lr)
For Each cel In Range("n2:n12")
Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
rng.AutoFilter field:=1, Criteria1:=cel.Value
rng.SpecialCells(xlCellTypeVisible).Copy ws.Cells(1, 1)
ws.Name = cel.Value
ws.UsedRange.EntireColumn.AutoFit
Next cel
rng.AutoFilter
Set ws = Nothing: Set rng = Nothing: Set cel = Nothing
End Sub

 

[BuiQuangThuan]

Bạn thử kiêm tra vùng từ n2 đến N12 xem các ô đó có chứa kí tự đặc biệt không

 

[Maika8008]

Nếu người hỏi biết hỏi thì chụp cái hộp thoại báo lỗi.

Danh sách của bạn có 2 cái VP BHXH tỉnh kìa! Lỗi đó chứ đâu.

 

[thanhnam0119]

Nếu người hỏi biết hỏi thì chụp cái hộp thoại báo lỗi.

Danh sách của bạn có 2 cái VP BHXH tỉnh kìa! Lỗi đó chứ đâu.

Dạ vâng anh ạ. em cảm ơn anh nhiều. Em xoá vẫn bị ạ

 

[Maika8008]

Nhưng sau này cần nhớ chụp hộp thoại báo lỗi trước khi bấm Debug ấy, chứ không phải chụp trang VBA.

 

[thanhnam0119]

Nhưng sau này cần nhớ chụp hộp thoại báo lỗi trước khi bấm Debug ấy, chứ không phải chụp trang VBA.

Dạ vâng anh đây là lỗi anh ạ. Bác xem giúp em ạ

 

[Maika8008]

Dạ vâng anh đây là lỗi anh ạ. Bác xem giúp em ạ

Bạn xóa đi thì phải sửa lại địa chỉ vùng thành N2:N11 thôi chứ. Trong chuyện này người ta thường lấy vùng động, tức là lấy số dòng dưới cùng endR kèm với địa chỉ thành N2:N & endR

Code tính luôn tổng chân cho bạn đây:

Sub tach()
Sheet1.Activate
Dim lr As Long
Dim rng As Range, cel As Range
Dim ws As Worksheet
lr = Range("h" & Rows.Count).End(xlUp).Row
Set rng = Range("a1:g" & lr)
For Each cel In Range("n2:n" & Range("N65536").End(xlUp).Row)
Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
rng.AutoFilter field:=1, Criteria1:=cel.Value
rng.SpecialCells(xlCellTypeVisible).Copy ws.Cells(1, 1)
ws.Name = cel.Value
ws.UsedRange.EntireColumn.AutoFit
Range("F65536").End(xlUp).Offset(1) = WorksheetFunction.Sum(Range("F2:F" & Range("F65536").End(xlUp).Row))
Range("G65536").End(xlUp).Offset(1) = WorksheetFunction.Sum(Range("G2:G" & Range("F65536").End(xlUp).Row))
Next cel
rng.AutoFilter
Set ws = Nothing: Set rng = Nothing: Set cel = Nothing
End Sub

 

[thanhnam0119]

Bạn xóa đi thì phải sửa lại địa chỉ vùng thành N2:N11 thôi chứ. Trong chuyện này người ta thường lấy vùng động, tức là lấy số dòng dưới cùng endR kèm với địa chỉ thành N2:N & endR

dạ vâng em sửa lại rồi và chạy rồi ạ. Bác giúp em thêm code tính tổng khi tách sheet được không ạ. Em cảm ơn anh nhiều

 

[Maika8008]

dạ vâng em sửa lại rồi và chạy rồi ạ. Bác giúp em thêm code tính tổng khi tách sheet được không ạ. Em cảm ơn anh nhiều

Chạy code bên trên. Hai người hơi bị lệch pha chút

 

[thanhnam0119]

Chạy code bên trên. Hai người hơi bị lệch pha chút

Bác giúp em tính tổng có điều kiện bằng VBA được không ạ. Em dùng Sumifs hơi thủ công ạ. Em cảm ơn bác nhiều

 

[Maika8008]

Để mai tôi xem và làm cho!

 

[Maika8008]

Bác giúp em tính tổng có điều kiện bằng VBA được không ạ. Em dùng Sumifs hơi thủ công ạ. Em cảm ơn bác nhiều

Trời! Chỉ 1 điều kiện và đã có sẵn mà bạn dùng Sumifs rồi cả Vlookup nữa! Chẳng hạn như D8 chỉ cần =SUMIF(DL!$C$2:$C$3227;B8;DL!$F$2:$F$3227) thôi chứ đâu mà dài dòng như bạn.

Còn vụ dùng VBA để tính thì chỉ cần dùng hàm WorksheetFunction.Sumif y như vậy để gán vào ô. Bạn tập dùng vòng lặp để làm đi, nếu không được thì báo lại cho tôi.

 

[thanhnam0119]

Em l

Trời! Chỉ 1 điều kiện và đã có sẵn mà bạn dùng Sumifs rồi cả Vlookup nữa! Chẳng hạn như D8 chỉ cần =SUMIF(DL!$C$2:$C$3227;B8;DL!$F$2:$F$3227) thôi chứ đâu mà dài dòng như bạn.

Còn vụ dùng VBA để tính thì chỉ cần dùng hàm WorksheetFunction.Sumif y như vậy để gán vào ô. Bạn tập dùng vòng lặp để làm đi, nếu không được thì báo lại cho tôi.

Em làm không được nhờ bác cao tay giúp ạ

 

[Maika8008]

Em l

Em làm không được nhờ bác cao tay giúp ạ

Ít dòng tổng như bạn thì gán trực tiếp vào ô cũng được nhưng trong file tôi đưa vào mảng rồi mới chép ra ô

 

[thanhnam0119]

Em cảm ơn anh nhiều ạ! Cái em rất cần

Ít dòng tổng như bạn thì gán trực tiếp vào ô cũng được nhưng trong file tôi đưa vào mảng rồi mới chép ra ô

 

[thanhnam0119]

Ít dòng tổng như bạn thì gán trực tiếp vào ô cũng được nhưng trong file tôi đưa vào mảng rồi mới chép ra ô

Bác giúp em khi gộp dữ liệu nhiều sheet của nhiều file vào một file thì code làm như nào ạ? Em cảm ơn a nhiều

 

[Maika8008]

Bác giúp em khi gộp dữ liệu nhiều sheet của nhiều file vào một file thì code làm như nào ạ? Em cảm ơn a nhiều

Bạn tìm kiếm trên GPE đi. Chủ đề này nhiều người đã hỏi và đã được code hoàn chỉnh.

Mẹo tìm: cứ search Google bằng các từ khóa như câu hỏi của bạn và kèm chứ giaiphapexcel

 

[thanhnam0119]

Bạn tìm kiếm trên GPE đi. Chủ đề này nhiều người đã hỏi và đã được code hoàn chỉnh.

Mẹo tìm: cứ search Google bằng các từ khóa như câu hỏi của bạn và kèm chứ giaiphapexcel

Dạ vâng anh. Em hỏi chút code gộp dữ liệu của em khi gộp toàn lên cả vùng trắng làm cách nào loại bỏ vùng trắng khi gộp không ạ

ub GopFileExcel()
    Dim FilesToOpen
    Dim x As Integer
    Dim wb As Workbook

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls),(*.xlsx), *.xls,*.xlsx", MultiSelect:=True, Title:="Files to Merge")
   
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
       
        If x = 1 Then
            wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
           
        End If
       
        wb.Close False
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wb = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[Maika8008]

Bạn thay chỗ này:
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)

End If

Bằng:
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
wb.Sheets(1).Range("A5:AY" & wb.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If

Trong đó: với dữ liệu của bạn thì lưu ý:
lr = ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row => Range("C" đó phải là cột có dữ liệu liên tục trong vùng dữ liệu (thay bằng tên cột của bạn)
wb.Sheets(1).Range("A5:AY" & wb.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row).Copy => Range("A5:AY này là vùng dữ liệu cần gộp (thay bằng địa chỉ vùng của bạn). Range("C" y như trên

 

[thanhnam0119]

Bạn thay chỗ này:
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)

End If

Bằng:
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
wb.Sheets(1).Range("A5:AY" & wb.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If

Trong đó: với dữ liệu của bạn thì lưu ý:
lr = ThisWorkbook.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row => Range("C" đó phải là cột có dữ liệu liên tục trong vùng dữ liệu (thay bằng tên cột của bạn)
wb.Sheets(1).Range("A5:AY" & wb.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row).Copy => Range("A5:AY này là vùng dữ liệu cần gộp (thay bằng địa chỉ vùng của bạn). Range("C" y như trên

Em cảm ơn bác nhiều. Cho em hỏi nếu muốn gộp dữ liệu tiếp theo mà không ghi đè lên dữ liệu cũ thì dùng code nào phù hợp ạ