Dim Tmem() 'variable tableau mémorisée pour être utilisée ultérieurement si nécessaire
Sub Extraire()
Dim t, i&, j%
t = Feuil1.[A5].CurrentRegion.Resize(, 15) 'matrice, plus rapide
ReDim Tmem(1 To UBound(t), 1 To 6) 'RAZ
For i = 1 To UBound(t)
j = InStr(t(i, 2), " ")
If j = 0 Then j = Len(t(i, 2)) + 1
Tmem(i, 1) = t(i, 4)
Tmem(i, 2) = Left(t(i, 2), j - 1)
Tmem(i, 3) = Mid(t(i, 2), j + 1)
Tmem(i, 4) = t(i, 15)
Tmem(i, 5) = t(i, 11)
Tmem(i, 6) = t(i, 13)
Next
End Sub
Sub Copie1()
Extraire
Application.ScreenUpdating = False
With Workbooks.Add.Sheets(1) 'nouveau classeur
.[A2].Resize(UBound(Tmem), 6) = Tmem
.[A1].Resize(, 6) = [{"Sign","Nom","Prénom","Téléphone","Cat","Qual"}]
.Rows(1).Font.Bold = True 'gras
.Columns.AutoFit 'ajustement largeur
'au besoin enregistrer et fermer le classeur
End With
End Sub
Sub Copie2()
Dim source As Range
Set source = Feuil1.[A5].CurrentRegion.Resize(, 15)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Add.Sheets(1) 'nouveau classeur
source.Columns(4).Copy .[A2]
source.Columns(2).Copy .[B2:C2] '2 colonnes de même formats
.[B:B].TextToColumns .[B2], xlDelimited, Space:=True 'commande Convertir
source.Columns(15).Copy .[D2]
source.Columns(11).Copy .[E2]
source.Columns(13).Copy .[F2]
.[A1].Resize(, 6) = [{"Sign","Nom","Prénom","Téléphone","Cat","Qual"}]
.Rows(1).Font.Bold = True 'gras
.Columns.AutoFit 'ajustement largeur
'au besoin enregistrer et fermer le classeur
End With
End Sub