Inkorten van vba code

[jan2009]

Hallo,

Ik gebruik onderstaande code om voor elke sheet de niet gebruikte kolom te verbergen, maar volgens mij moet die een heel eind korter kunnen , maar ik kom er niet uit.

Kan iemand mij helpen?

de code is:

For Each sh In Application.Workbooks("overslag gegevens.xlsx").Sheets

sh.rows("5").PasteSpecial
sh.Range("a1").Value = "Klantnaam:"
sh.Range("a2").Value = "Klantnummer:"
sh.Range("a3").Value = "week:"
'overbodige kolommen verbergen

sh.columns.AutoFit
sh.columns("B:F").EntireColumn.Hidden = True

sh.Range("g1").Value = sh.Range("d6").Value
sh.Range("g2").Value = sh.Range("e6").Value
sh.Range("g3").Value = sh.Range("b6").Value

If Application.WorksheetFunction.CountA(sh.Range("h6:h20").cells) = 0 Then
sh.columns("H").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("i6:i20").cells) = 0 Then
sh.columns("i").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("j6:j20").cells) = 0 Then
sh.columns("j").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("k6:k20").cells) = 0 Then
sh.columns("k").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("l6:l20").cells) = 0 Then
sh.columns("l").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("m6:m20").cells) = 0 Then
sh.columns("m").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("n6:n20").cells) = 0 Then
sh.columns("n").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("o620").cells) = 0 Then
sh.columns("o").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("p620").cells) = 0 Then
sh.columns("p").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("q6:q20").cells) = 0 Then
sh.columns("q").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("r6:r20").cells) = 0 Then
sh.columns("r").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("s6:s20").cells) = 0 Then
sh.columns("s").EntireColumn.Hidden = True
End If

If Application.WorksheetFunction.CountA(sh.Range("t6:t20").cells) = 0 Then
sh.columns("t").EntireColumn.Hidden = True
End If
Next sh

 

[snb]

For Each sh In Application.Workbooks("overslag gegevens.xlsx").Sheets
  With sh
    .rows("5").PasteSpecial
    for j=1 to 3
       .cells(j,1)= choose(j,"Klantnaam:","Klantnummer:","week:"
       .cells(j,7)=.cells(6,choose(j,4.5,2))
    next

    .columns.AutoFit
    .columns("B:F").Hidden = True
  
    on error resume next
    for j= 8 to 20
       .cells(6,j).resize(13).specialcells(2).select
       if err.number>0 then .columns(j).hidden=true
       err.clear
    next
Next