Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$2" Then Exit Sub
Me.Names.Add "col", Application.Match(Target, [B2:IV2], 0)
If IsError([col]) Then
CommandButton1.Enabled = False
[B:IV].EntireColumn.Hidden = False
On Error Resume Next
Me.ShowAllData
Else
CommandButton1.Enabled = True
Intersect([B:IV], Me.UsedRange).EntireColumn.Hidden = True
Columns([col] + 1).Resize(, 2).Hidden = False
End If
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Workbooks.Add
With ActiveWorkbook.Sheets(1)
Me.UsedRange.SpecialCells(xlCellTypeVisible).Copy .[A1]
.[1:1].Delete
.[B1] = ""
Application.DisplayAlerts = False
On Error Resume Next
.SaveAs "C:\DONNEES\" & .[A1] & ".crd", xlCSV
If Err Then MsgBox "Créez le dossier 'C:\DONNEES' !"
ActiveWindow.Close False
End With
End Sub