insert coloum semua sheet

  1. 2 bulan yang lalu

    Dear suhu.....,
    mohon dapat dibantu perbaikan script dibawah ini, kok berfungsi cuma untuk 1 sheet saja, tidak bisa untuk beberapa sheet
    kenapa yah....

    Sub insertcoloum()
    On Error Resume Next
    If Not Application.ActiveWorkbook Is Nothing Then
    Dim xlSheet As Worksheet

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each xlSheet In ActiveWorkbook.Worksheets
    If Application.WorksheetFunction.CountBlank(Range("A1:A1")) < 1 Then
    Columns("A:D").Select
    Selection.Insert Shift:=xlToRight
    End If
    Next

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End If

    Err.Clear
    On Error GoTo 0
    End Sub

    terima kasih

  2. manweljs_

    Jul 17 Terverifikasi + 5.020 Poin
    Di sunting 2 bulan yang lalu oleh manweljs_

    @nafis2006

    coba :

    ....
    For Each xlSheet In ActiveWorkbook.Worksheets
        If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1")) < 1 Then
        xlSheet.Columns("A:D").Insert Shift:=xlToRight
        End If
    Next xlSheet
    ....

    atau

    ....
    For Each xlSheet In ActiveWorkbook.Worksheets
        With xlSheet
        If Application.WorksheetFunction.CountBlank(.Range("A1")) < 1 Then
            .Columns("A:D").Insert Shift:=xlToRight
        End If
        End With
    Next xlSheet
    ....

  3. makasih mas Manweljs.....

    sudah berfungsi....

    met sukses selalu

  4. Dear mas Manweljs.....
    Mohon maaf nih jadi banyak bertanya....

    Kalau misalnya ada sheet yang namanya "MASTER" script diatas tidak akan berfungsi,
    saya harus merubah di row yang mana yah mas....

    mohon pencerahan...

    terima kasih

  5. manweljs_

    Jul 18 Terverifikasi + 5.020 Poin
    Di sunting 2 bulan yang lalu oleh manweljs_

    @nafis2006

    sama halnya dengan disebelah, gunakan IF untuk memfilter suatu kondisi :

    ....
    For Each xlSheet In ActiveWorkbook.Worksheets
    If xlSheet.Name <> "MASTER" Then
        If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1")) < 1 Then
        xlSheet.Columns("A:D").Insert Shift:=xlToRight
        End If
    End if
    Next xlSheet
    ....

  6. Dear mas Manweljs.....

    mantap .... script nya.... bener2 nambah ilmu...

    makasih banyak mas

  7. manweljs_

    Jul 18 Terverifikasi + 5.020 Poin

    sama-sama mas ;)

 

atau Mendaftar untuk ikut berdiskusi!