Lỗi 400 khi dùng lệnh Hidden trong VBA

[zztantaibazz]

Hi mọi người.
Em viết đoạn code để tạo sheet và hidden dòng trống nhưng hay bị lỗi 400. Nhờ mọi người file giúp em. Thanks mọi người

Function CreateNewSheet(Rg1 As Range)    Dim Rg As Range
    For Each Rg In Rg1
        If Rg.Value = "" Then
        Worksheets("Template").Visible = False
            Exit Function
        End If
        If CheckSheetAvailable(Rg.Value) Then
        Else
        ActiveWorkbook.Worksheets("Template").Visible = True
        ActiveWorkbook.Sheets("Template").Copy After:=Sheets(Sheets.Count)
        End If
        With ActiveSheet
        .Name = Rg.Value
        .Range("B5").Value = Rg.Value
        .Calculate
        .Rows("3:62").EntireRow.AutoFit
        .Range(Range("A4").Value & ":62").Select
            Selection.EntireRow.Hidden = True
    
        End With
    Next
End Function
Function CheckSheetAvailable(sname As String) As Boolean
    Dim sheet As Worksheet
    For Each sheet In ActiveWorkbook.Worksheets
        If sheet.Name = sname Then
            CheckSheetAvailable = True
            Exit Function
        End If
    Next
    CheckSheetAvailable = False
End Function

Code như trên và em đính kèm file luôn.

 

[siwtom]

Hi mọi người.
Em viết đoạn code để tạo sheet và hidden dòng trống nhưng hay bị lỗi 400. Nhờ mọi người file giúp em. Thanks mọi người

Function CreateNewSheet(Rg1 As Range)    Dim Rg As Range
    For Each Rg In Rg1
        If Rg.Value = "" Then
        Worksheets("Template").Visible = False
            Exit Function
        End If
        If CheckSheetAvailable(Rg.Value) Then
        Else
        ActiveWorkbook.Worksheets("Template").Visible = True
        ActiveWorkbook.Sheets("Template").Copy After:=Sheets(Sheets.Count)
        End If
        With ActiveSheet
        .Name = Rg.Value
        .Range("B5").Value = Rg.Value
        .Calculate
        .Rows("3:62").EntireRow.AutoFit
        .Range(Range("A4").Value & ":62").Select
            Selection.EntireRow.Hidden = True
    
        End With
    Next
End Function
Function CheckSheetAvailable(sname As String) As Boolean
    Dim sheet As Worksheet
    For Each sheet In ActiveWorkbook.Worksheets
        If sheet.Name = sname Then
            CheckSheetAvailable = True
            Exit Function
        End If
    Next
    CheckSheetAvailable = False
End Function

Code như trên và em đính kèm file luôn.

Tôi không tải tập tin, chỉ nhìn code rồi thử sửa thôi. Bạn kiểm tra xem sao

Function CreateNewSheet(Rg1 As Range)
Dim Rg As Range, sheetname As String
    ActiveWorkbook.Worksheets("Template").Visible = True
    For Each Rg In Rg1
        sheetname = Trim(Rg.Value)
        If sheetname <> "" Then
            If Not CheckSheetAvailable(sheetname) Then    '
                ActiveWorkbook.Sheets("Template").Copy After:=Sheets(Sheets.Count)
                With ActiveSheet
                    .Name = sheetname
                    .Range("B5").Value = sheetname
                    .Calculate
                    .Rows("3:62").EntireRow.AutoFit
                    .Range(Range("A4").Value & ":62").Select
                        Selection.EntireRow.Hidden = True
                End With
            End If
        End If
    Next
    ActiveWorkbook.Worksheets("Template").Visible = False
End Function

 

[zztantaibazz]

Thanks bạn.
Mình cũng hem biết lỗi sao nữa. Tạo ra 1 file khác chạy code ok. Chạy trong file mình mình đính kèm á thì bị lỗi.