Giúp đỡ xử lý tạo Macro xuất dữ liệu ra nhiều Sheet (1 người xem)

[halvbkfet]

Dear các anh/chị
Em có 1 case chưa biết xử lý thế nào nhờ các anh/chị tư vấn xử lý MACRO giúp ạ, cụ thể là ntn:
Em có 1 file Excel gồm 1 sheet chứa trường thông tin + 1 sheet biểu mẫu cần xuất ra (Sheet 2 này có hàm link từ Sheet 1 sang sao cho khi đổi giá trị ở ô màu đỏ (C3-sheet2) bằng các giá trị thứ tự từ trên xuống dưới của cột B bên sheet 1 thì sẽ thành 1 nội dung khác --> Sheet này là sheet cần tạo ra).
--> Sản phẩm: Cần mỗi 1 giá trị trong cột B (sheet 1) chạy từ B3 đến hết (B18) sẽ tạo ra 1 sheet mới hoàn toàn theo mẫu của sheet 2 ("BM01") - đặt tên sheet mới này theo mã trong cột B để phân biệt. Có 16 giá trị trong cột B thì xuất ra 16 sheet mới ở workbook.
Nhờ các anh/chị giúp ạ!

 

[halvbkfet]

Có anh chị nào làm case này chưa ạ!

 

[HieuCD]

bạn chạy thử code nầy

Sub GPE()
Dim Darr(), i As Long, Test
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Danh sach")
    If .Range("B65500").End(xlUp).Row < 3 Then Exit Sub
    Darr = .Range("B3:B" & .Range("B65500").End(xlUp).Row).Value
End With
For i = 1 To UBound(Darr)
    Test = Sheets(Darr(i, 1)).Name
    If Err.Number <> 0 Then
        Err.Clear
        Sheets("BM01").Select
        Sheets("BM01").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Darr(i, 1)
        Range("C3").FormulaR1C1 = "='Danh sach'!R" & i + 2 & "C2"
    Else
        GoTo tiep
    End If
tiep:
Next i
Application.ScreenUpdating = True
End Sub

 

[haonlh]

Bạn tách ra như vậy để dùng cho chính mình (ví dụ để in) hay để gửi cho nhiều người khác nhau (để họ chỉ nhìn được thông tin của mình).

 

[halvbkfet]

bạn chạy thử code nầy

Sub GPE()
Dim Darr(), i As Long, Test
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Danh sach")
    If .Range("B65500").End(xlUp).Row < 3 Then Exit Sub
    Darr = .Range("B3:B" & .Range("B65500").End(xlUp).Row).Value
End With
For i = 1 To UBound(Darr)
    Test = Sheets(Darr(i, 1)).Name
    If Err.Number <> 0 Then
        Err.Clear
        Sheets("BM01").Select
        Sheets("BM01").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Darr(i, 1)
        Range("C3").FormulaR1C1 = "='Danh sach'!R" & i + 2 & "C2"
    Else
        GoTo tiep
    End If
tiep:
Next i
Application.ScreenUpdating = True
End Sub

Em cảm ơn anh nhé!

 

[halvbkfet]

Bạn tách ra như vậy để dùng cho chính mình (ví dụ để in) hay để gửi cho nhiều người khác nhau (để họ chỉ nhìn được thông tin của mình).

Em đang học để làm form in ra mẫu ạ

 

[halvbkfet]

bạn chạy thử code nầy

Sub GPE()
Dim Darr(), i As Long, Test
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Danh sach")
    If .Range("B65500").End(xlUp).Row < 3 Then Exit Sub
    Darr = .Range("B3:B" & .Range("B65500").End(xlUp).Row).Value
End With
For i = 1 To UBound(Darr)
    Test = Sheets(Darr(i, 1)).Name
    If Err.Number <> 0 Then
        Err.Clear
        Sheets("BM01").Select
        Sheets("BM01").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Darr(i, 1)
        Range("C3").FormulaR1C1 = "='Danh sach'!R" & i + 2 & "C2"
    Else
        GoTo tiep
    End If
tiep:
Next i
Application.ScreenUpdating = True
End Sub

Hi anh,
Làm sao để chạy được không giới hạn Sheet (có thể lớn hơn nhiều so với con số 255 sheet). Em chỉ chạy đc khoảng >100 Sheet là MAX, dữ liệu vẫn còn nhưng không chạy ra được nữa.
Nhờ anh tư vấn giúp em nhé!

 

[HieuCD]

Hi anh,
Làm sao để chạy được không giới hạn Sheet (có thể lớn hơn nhiều so với con số 255 sheet). Em chỉ chạy đc khoảng >100 Sheet là MAX, dữ liệu vẫn còn nhưng không chạy ra được nữa.
Nhờ anh tư vấn giúp em nhé!

số sheet tối đa lệ thuộc vào cấu hình máy tính, bạn phải nâng cấp phần cứng.
mình nghĩ với các sheet có cấu trúc như nhau, chỉ cần 1 sheet, khi cần xem hoặc in bạn thay tên tương ứng