Tạo sheet mới

[laydaihiep]

Bạn "Let'GâuGâu" đã giúp mình: https://www.giaiphapexcel.com/diendan/threads/giúp-mình-viết-macro-này-với.106206/#post-660559

Sub laydaihiep()
Dim wsNew As Worksheet, wsMain As Worksheet
Dim list_of_existing As String, Target As Range

Set wsMain = Sheets("Danh muc")
For Each Target In wsMain.Range([A10], [A60000].End(3))
If Not IsEmpty(Target) Then
On Error Resume Next
Set wsNew = ThisWorkbook.Sheets(Target.Value)
On Error GoTo 0
If Not wsNew Is Nothing Then
list_of_existing = list_of_existing & vbCrLf & Target.Value
Else
ThisWorkbook.Sheets("(1÷15)D1m").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With Sheets(ThisWorkbook.Sheets.Count)
.Name = Target.Value
.[e12] = wsMain.Range(Target.Address).Offset(, 3).Value
End With
End If
Set wsNew = Nothing
End If
Next Target
Set wsMain = Nothing
If Len(list_of_existing) > 0 Then
MsgBox "Cap nhat cac sheet moi da thanh cong !"
End If
End Sub
Nhưng mình cần chỉnh sửa đoạn code tạo sheet trong vùng chọn ở trên từ U10-V10, U10 và V10 mình chọn bất kỳ. Bác pro nào giúp mình với. Thank!

 

[tam888]

Vì khó hiểu code nên:
Đoán đại, thử thay

For Each Target In wsMain.Range([A10], [A60000].End(3))

thành

For Each Target In wsMain.Range("U10:V10")

 

[laydaihiep]

Vì khó hiểu code nên:
Đoán đại, thử thay

For Each Target In wsMain.Range([A10], [A60000].End(3))

thành

For Each Target In wsMain.Range("T10:U10")

Thank bạn!
Hôm trước mình gửi nhầm file, bạn có thể giúp mình

For Each Target In wsMain.Range([A vị trí T10 trong A10-A6000], [A vị trí U10 trong A10-A6000].End(3))

Xem file đính kèm mình nghĩ bạn sẽ hiểu, mong bạn thông cảm vì mình không rành code, Rất mong được sự giúp đở của bạn!

 

[laydaihiep]

Sub laydaihiep()
Dim wsNew As Worksheet, wsMain As Worksheet
Dim list_of_existing As String, Target As Range
Dim X, Y
X = Application.Match("T10", Range("A1:A6000"), 0)
Y = Application.Match("U10", Range("A1:A6000"), 0)
Set wsMain = Sheets("Danh muc")
For Each Target In wsMain.Range("A" & X & ":B" & Y)
If Not IsEmpty(Target) Then
On Error Resume Next
Set wsNew = ThisWorkbook.Sheets(Target.Value)
On Error GoTo 0
If Not wsNew Is Nothing Then
list_of_existing = list_of_existing & vbCrLf & Target.Value
Else
ThisWorkbook.Sheets("nguon").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With Sheets(ThisWorkbook.Sheets.Count)
.Name = Target.Value
.[e12] = wsMain.Range(Target.Address).Offset(, 3).Value
End With
End If
Set wsNew = Nothing
End If
Next Target
Set wsMain = Nothing
If Len(list_of_existing) > 0 Then
MsgBox "Cap nhat cac sheet moi da thanh cong !"
End If
End Sub
Mình viết đoạn code nhưng bị lỗi tại For Each Target In wsMain.Range("A" & X & ":B" & Y)
pro nào giúp mình với

 

[laydaihiep]

Sao không ai giúp mình nhỉ?

 

[leonguyenz]

Sao không ai giúp mình nhỉ?

Kiểm tra lại kết quả trong file.

Sub laydaihiep2()
Dim wsNew As Worksheet, wsMain As Worksheet
Dim list_of_existing As String, Target As Range
Dim X As Integer, Y As Integer
Set wsMain = Sheets("Danh muc")
X = Application.Match(wsMain.Range("T10"), wsMain.Range("A1:A6000"), 0)
Y = Application.Match(wsMain.Range("U10"), wsMain.Range("A1:A6000"), 0)
For Each Target In wsMain.Range("A" & X & ":B" & Y)
    If Not IsEmpty(Target) Then
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets(Target.Value)
            On Error GoTo 0
        If Not wsNew Is Nothing Then
            list_of_existing = list_of_existing & vbCrLf & Target.Value
        Else
            ThisWorkbook.Sheets("nguon").Copy _
                After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            With Sheets(ThisWorkbook.Sheets.Count)
                .Name = Target.Value
                .[E12] = wsMain.Range(Target.Address).Offset(, 3).Value
            End With
        End If
        Set wsNew = Nothing
    End If
Next Target
Set wsMain = Nothing
If Len(list_of_existing) > 0 Then
    MsgBox "Cap nhat cac sheet moi da thanh cong !"
End If
End Sub

 

[be_09]

Sao không ai giúp mình nhỉ?

Không thành viên nào trả lời do bạn không giải thích rỏ ràng nên không ai hiểu bạn muốn làm như thế nào?
Theo tôi hiểu là:
Dựa vào cột A sheet Danh muc tách mỗi dòng từ dòng 10: 19 ra mỗi dòng là 1 biên bản, mẫu biên bản là sheet nguon.

 

[laydaihiep]

Không thành viên nào trả lời do bạn không giải thích rỏ ràng nên không ai hiểu bạn muốn làm như thế nào?
Theo tôi hiểu là:
Dựa vào cột A sheet Danh muc tách mỗi dòng từ dòng 10: 19 ra mỗi dòng là 1 biên bản, mẫu biên bản là sheet nguon.

Đúng rồi bạn, nhưng mình muốn tách từ dòng T10, U10 (gián tiếp qua 2 ô chọn mình đã làm sẵn) T10, U10 thuộc cột A

Bài đã được tự động gộp: 3/5/19

Kiểm tra lại kết quả trong file.

Sub laydaihiep2()
Dim wsNew As Worksheet, wsMain As Worksheet
Dim list_of_existing As String, Target As Range
Dim X As Integer, Y As Integer
Set wsMain = Sheets("Danh muc")
X = Application.Match(wsMain.Range("T10"), wsMain.Range("A1:A6000"), 0)
Y = Application.Match(wsMain.Range("U10"), wsMain.Range("A1:A6000"), 0)
For Each Target In wsMain.Range("A" & X & ":B" & Y)
    If Not IsEmpty(Target) Then
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets(Target.Value)
            On Error GoTo 0
        If Not wsNew Is Nothing Then
            list_of_existing = list_of_existing & vbCrLf & Target.Value
        Else
            ThisWorkbook.Sheets("nguon").Copy _
                After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            With Sheets(ThisWorkbook.Sheets.Count)
                .Name = Target.Value
                .[E12] = wsMain.Range(Target.Address).Offset(, 3).Value
            End With
        End If
        Set wsNew = Nothing
    End If
Next Target
Set wsMain = Nothing
If Len(list_of_existing) > 0 Then
    MsgBox "Cap nhat cac sheet moi da thanh cong !"
End If
End Sub

Đây đúng là thứ mình cần, cảm ơn bạn nhiều, Cho mình hỏi thêm cái này nha!
Giả sử bảng tính của mình khoảng có 100 sheet và 2 sheet nguồn "Danh muc", "nguồn" bây giờ mình muốn chọn 98 sheet còn lại phải viết thế nào nhỉ?

 

[laydaihiep]

Giúp mình sửa lại hai đoạn code này với
Đoạn code thứ nhất Hide các hàng: mình viết code đặt vào nút "hide" như bị 1 vấn đề. khi chọn T10 = "Cấu kiện 1" thì bị hide hàng 9 và 10.
Đoạn cade thứ 2 chọn các sheet và xóa: khi thực hiện lệnh thì excel hiện các ô cửa bắt xác nhận có xóa hay không xóa,các bạn giúp mình bỏ bước này với.
Code mình viết đính kèm trong file excel
Thank các bạn trước!

 

[laydaihiep]

Có bác pro nào giúp em với...

 

[be_09]

Giúp mình sửa lại hai đoạn code này với
Đoạn code thứ nhất Hide các hàng: mình viết code đặt vào nút "hide" như bị 1 vấn đề. khi chọn T10 = "Cấu kiện 1" thì bị hide hàng 9 và 10.
Đoạn cade thứ 2 chọn các sheet và xóa: khi thực hiện lệnh thì excel hiện các ô cửa bắt xác nhận có xóa hay không xóa,các bạn giúp mình bỏ bước này với.
Code mình viết đính kèm trong file excel
Thank các bạn trước!

Xem thử File.
Không nên dùng từ pro này, pro nọ nhé, nội quy ghi cụ thể thế này: