АРХИВАЦИЯ ДАННЫХ И СКРЫТИЕ КОЛОНОК

[Cone]

Добрый день!
Нужен следующий макрос, в диапазоне от колонки G до AW, нужно провести проверку если в G6 разница указанной даты от сегодняшней (указана в ячейке B2) составляет более 20, то необходимо скрыть эту колонку и следующую т.е при выполнении условия должны сворачиваться 2 колонки ( в приведенном примере должны свернуться G и H). и потом проверка должна продолжаться с колонки I на разницу дат в I6 и текущей и так далее.!

И еще нужен макрос выполняющий архивацию данных т.е в том же диапазоне должен проверять наличие ячейки "выполнено" если значение найдено то необходимо также 2 две колонки (в той которая найдено и следующую вырезать и вставит в лист "ARCHIVE" начиная с колонки G)

Если кто0то может помочь буду очень признателен!
Заранее благодарю.

[EducatedFool]

А где пример файла?
Или его тоже мы должны сделать?

[Cone]

В приложении

[Cone]

даааааааа! видать задачка не так проста!

[doober]

даааааааа! видать задачка не так проста!

Да очень сложная,так как в

нужно провести проверку если в G6 разница указанной даты от сегодняшней

ничего в строке 6 нет.Строка 6 пустая.

[Cone]

Ясен перец нет , это же пример был! Что трудно можно подставить G12 , темболее в таблице это ясно видно! Вообще фаил это шаблон в который надо будет позже занести мероприятия! После их надо отсортировать и заархивировать которые помечены ЗАВЕРШЕНО!

[doober]

Макрос на скрытие столбцов

 Sub  Сложный()
Dim I As Integer
With Sheets("HEAD")
 For I = 7 To .Range("iv12").End(xlToLeft).Column Step 2
 If Now - CDate(.Cells(12, I)) > 20 Then
 .Columns(I).Hidden = True
 .Columns(I + 1).Hidden = True
 End If
 Next
 End With
End Sub

[Cone]

Огромное тебе человеческое спасибО doober!

[Cone]

Сообщение от doober

Макрос на скрытие столбцов

 Sub  Сложный()
Dim I As Integer
With Sheets("HEAD")
 For I = 7 To .Range("iv12").End(xlToLeft).Column Step 2
 If Now - CDate(.Cells(12, I)) > 20 Then
 .Columns(I).Hidden = True
 .Columns(I + 1).Hidden = True
 End If
 Next
 End With
End Sub

А почеум вот так не хочет работать??!

Sub hideree_()

Dim I As Integer
Dim DH As Integer
DH = InputBox("введите кол-во дней")
With Sheets("HEAD")
For I = 7 To .Range("iv12").End(xlToLeft).Column Step 2
If Now - CDate(.Cells(12, I)) > DH Then
.Columns(I).Hidden = True
.Columns(I + 1).Hidden = True
End If
Next
End With
End Sub

[Cone]

Сообщение от Cone

А почеум вот так не хочет работать??!

Sub hideree_()

Dim I As Integer
Dim DH As Integer
DH = InputBox("введите кол-во дней")
With Sheets("HEAD")
For I = 7 To .Range("iv12").End(xlToLeft).Column Step 2
If Now - CDate(.Cells(12, I)) > DH Then
.Columns(I).Hidden = True
.Columns(I + 1).Hidden = True
End If
Next
End With
End Sub

ОКАЗЫВАЕТСЯ ТАК ТОЖЕ РАБОТАЕТ !

СПАСИБО! ПРОБЛЕМА РЕШЕНА!



ОСТАЛОСЬ ТОКА МАКРОС НАЙТИ ЧТОБЫ АРХИВ СОСТАВЛЯТЬ!