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
Private Sub CommandButton1_Click()
Dim cel As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each cel In [B1:IV1].SpecialCells(xlCellTypeConstants)
Affiche cel.Text
Workbooks.Add
With ActiveWorkbook.Sheets(1)
Me.UsedRange.SpecialCells(xlCellTypeVisible).Copy .[A1]
.[A1] = cel: .[B1] = ""
On Error Resume Next
.SaveAs "C:\DONNEES\" & .[A1] & ".crd", xlCSV
ActiveWindow.Close False
If Err Then MsgBox "Créez le dossier 'C:\DONNEES' !": Exit Sub
End With
Next
Affiche ""
End Sub
Sub Affiche(txt As String)
Dim col As Variant
col = Application.Match(txt, [B1:IV1], 0)
If IsError(col) Then
[B:IV].EntireColumn.Hidden = False
Else
Intersect([B:IV], Me.UsedRange).EntireColumn.Hidden = True
Columns(col + 1).Resize(, 2).Hidden = False
End If
End Sub
C'est vrai que l'histoire des dates qui sortent en US, ça oblige à tout reconvertir.
Serait-il possible de les sortir directement en JJ/MM/AAAA afin d'optimiser le programme?