Xin hỏi cách tách dữ liệu từ sheet tổng ra từng sheet

[namtuoc]

Xin chào các bạn!
Mình có 1 sheet tổng hợp bao gồm danh mục thiết bị ở từng dòng, và đại điểm chia hàng ở từng cột.
Giờ mình muốn tự động xuất ra từng sheet theo cột, mỗi sheet là tên 1 địa điểm gồm cả danh mục thiết bị theo địa điểm đó.
Mình gửi kèm theo file đã hoàn thành, nhưng đó là làm thủ công thôi chứ số lượng rất nhiều, làm thủ công vừa lâu mà thiếu chính xác.
Mong các bạn giúp mình với nhé. Cảm ơn các bạn rất nhiều!

Mình có tìm được 1 cái add-in, nhưng nó lại tách mỗi sheet theo từng dòng chứ không phải theo cột như mình muốn. Mình gửi theo luôn để các bạn tham khảo nhé!

 

[snow25]

Xin chào các bạn!
Mình có 1 sheet tổng hợp bao gồm danh mục thiết bị ở từng dòng, và đại điểm chia hàng ở từng cột.
Giờ mình muốn tự động xuất ra từng sheet theo cột, mỗi sheet là tên 1 địa điểm gồm cả danh mục thiết bị theo địa điểm đó.
Mình gửi kèm theo file đã hoàn thành, nhưng đó là làm thủ công thôi chứ số lượng rất nhiều, làm thủ công vừa lâu mà thiếu chính xác.
Mong các bạn giúp mình với nhé. Cảm ơn các bạn rất nhiều!

Mình có tìm được 1 cái add-in, nhưng nó lại tách mỗi sheet theo từng dòng chứ không phải theo cột như mình muốn. Mình gửi theo luôn để các bạn tham khảo nhé!

Bạn thử code này.Nếu muốn đẹp thì làm thêm 1 sheets mẫu là được.

Sub tach()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Dim i As Long, lr As Long, lc As Long, arr, kq, sh As Worksheet, j As Long, a As Long
   For Each sh In ThisWorkbook.Worksheets
       If sh.Name <> "Danh sach SN Tram NET1" Then
          sh.Delete
       End If
   Next
   With Sheets("Danh sach SN Tram NET1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        lc = .Cells(4, Columns.Count).End(xlToLeft).Column
        arr = .Range("A1").Resize(lr, lc).Value
   End With
   For j = 5 To lc - 2 Step 2
       Worksheets.Add
       Set sh = ActiveSheet
       sh.Name = arr(3, j)
       ReDim kq(1 To lr, 1 To 8)
       a = 6
       kq(1, 1) = arr(1, 1) & " " & arr(3, j)
       For i = 4 To 6
              kq(i, 1) = arr(i, 1)
              kq(i, 2) = arr(i, 2)
              kq(i, 3) = arr(i, 3)
              kq(i, 4) = arr(i, 4)
              kq(i, 7) = arr(i, lc - 1)
              kq(i, 8) = arr(i, lc)
      Next i
        For i = 5 To UBound(arr)
           If arr(i, j) > 0 Then
              a = a + 1
              kq(a, 1) = arr(i, 1)
              kq(a, 2) = arr(i, 2)
              kq(a, 3) = arr(i, 3)
              kq(a, 4) = arr(i, 4)
              kq(a, 5) = arr(i, j)
              kq(a, 6) = arr(i, j + 1)
              kq(a, 7) = arr(i, lc - 1)
              kq(a, 8) = arr(i, lc)
           End If
      Next i
      sh.Range("a1").Resize(lr, 8).Value = kq
  Next j
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

 

[namtuoc]

Bạn thử code này.Nếu muốn đẹp thì làm thêm 1 sheets mẫu là được.

Cảm ơn bạn đã giúp đỡ rất nhanh và chính xác!
Xin lỗi bạn vì chiều nay mình bận quá không trả lời bạn sớm.

Đoạn code của bạn dùng tốt lắm nhưng có 2 vấn đề chưa được như mong muốn của mình:
1. Các sheet mới xuất hiện về phía trái. Mình muốn về phía phải được không bạn?
2. Mình muốn đẹp như file mẫu. Nhưng không biết cách làm. Mình thử làm 1 sheet mẫu nhưng khi chạy code nó lại về định dạng bình thường

 

[Cu Tồ]

muốn về phía phải

Ở dòng

Worksheets.Add

Thêm thành

Worksheets.Add After:=ActiveSheet

 

[namtuoc]

Cảm ơn các bạn!
À, có chút lỗi nhỏ, ở dòng tiêu đề khi xuất ra các sheet, bị mất cột "Số lượng" và cột "Serial number"
Các bạn xem lại giúp mình với.

 

[Nhattanktnn]

Cảm ơn các bạn!
À, có chút lỗi nhỏ, ở dòng tiêu đề khi xuất ra các sheet, bị mất cột "Số lượng" và cột "Serial number"
Các bạn xem lại giúp mình với.

Thêm vào:

For i = 4 To 6
              kq(i, 1) = arr(i, 1)
              kq(i, 2) = arr(i, 2)
              kq(i, 3) = arr(i, 3)
              kq(i, 4) = arr(i, 4)
              kq(i, 5) = arr(i, 5)
              kq(i, 6) = arr(i, 6)
              kq(i, 7) = arr(i, lc - 1)
              kq(i, 8) = arr(i, lc)
      Next i

 

[namtuoc]

Đã ok rồi, cảm ơn các bạn nhiều lắm!
Nhưng làm sheet mẫu như thế nào nhỉ? Khi chạy code nó lại ghi đè lên thôi

 

[Nhattanktnn]

Đã ok rồi, cảm ơn các bạn nhiều lắm!
Nhưng làm sheet mẫu như thế nào nhỉ? Khi chạy code nó lại ghi đè lên thôi

Code hơi loằng ngoằng tí, nhưng nói chung dùng được: