VBA\Smazání sloupců s podmínkou Vyřešeno

[r4ms3scz]

Ahoj,

chtěl bych poprosit o pomoc.

Potřebuji vytvořit makro, které smaže sloupec za podmínky, ze buňky v daném sloupci budou prázdné. Pokud byť jedna buňka ve sloupci bude čímkoliv vyplněna, sloupec ponechat. Sloupec vyhodnocovat od druhé buňky do buňky 10 001, takže např. A2:A10001. vyhodnocovat každý sloupec zvlášť a vyhodnocovat sloupce A až např BZ (A:BZ). Nevyhodnocovat první buňku ve sloupci, tam vždy bude hlavička.

Děkuji

[Reklama]

[cmuch]

Makro vlož do modulu listu kde se má provést.

Kód: Vybrat vše

Sub SmazSloupce()

 Dim clmOd As Integer, clmDo As Integer
 Dim rowOd As Integer, rowDo As Integer
 
 Application.ScreenUpdating = False
 
 'nastaveni
 clmOd = Range("a" & "1").Column     'od sl. A
 clmDo = Range("bz" & "1").Column    'do sl. BZ
 rowOd = 2                           'od jakeho radku
 rowDo = 10001                       'do jakeho radku - max.1048575
 
 'opakuj pro sloupce z nastaveni
 For clmDo = clmDo To clmOd Step -1
  'pokud v zadanych radcich nic neni tak smaz sloupec
  If Cells(rowDo + 1, clmDo).End(xlUp).Row < rowOd Then
    Columns(clmDo).Delete
  End If
 Next
 Application.ScreenUpdating = True
End Sub