Ci-joint un fichier que j'ai enregistrer en 2003.
Je ne sais pas si la macro est enregistrer avec !
Dans le doute, voilà :
'Option Explicit
Sub Organise()
Dim J As Long
Dim I As Integer
Dim NbCol As Integer
Dim Lg As Long
Dim Colonnes_A_Supprimer As String
Dim MétierAPrendreEnCompte As String
Dim ColonneMETIER As Long
Dim ColonneZ438NOM As Long
Dim ColonneJAN2013 As Long
Dim DateEnChiffres As Date
Dim x As Date
Dim y As Date
'---------BLOC 1 pour trouver les n° de colonnes des données sensibles et pour filtrer les données utiles------------------------------------------
' colonne METIER
' Pour éviter les erreurs dues à une modification d'emplacement d'une colonne, je vais attribuer un nom à la colonne METIER que je
' vais mettre dans le tableau en liste
' Pour cela, je vais :
' 1- Chercher le titre "METIER"
' 2- Récupérer le n° de la colonne
' 3- Associer le n° de ligne (J) au n° de la colonne (ColonneMETIER), pour faire apparaître la référence dans le tableau "Array"
'COLONNE METIER
'Je sélectionne la cellule en haut à gauche
Range("A1").Activate
ActiveCell.Select
'je cherche le mot METIER dans la 1ère ligne
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:="METIER", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
'Je sélectionne la cellule trouvée
ActiveCell.Select
' J'affecte le n° de colonne de la cellule active à la valeur ColonneMETIER
ColonneMETIER = ActiveCell.Column
'---------BLOC 2 Pour constituer le tableau final------------------------------------------
' Lg indique où commence le tableau en liste : ici ligne 1
Lg = 1
Application.ScreenUpdating = False
With Sheets("Fichier à plat")
NbCol = Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(Lg, "A").Resize(1, 8) = Array(Range("A1"), Range("B1"), Range("C1"), Range("D1"), Range("E1"), _
Range("F1"), "Date", "Valeur")
For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
' I indique le rang de la colonne de début (col A étant 1, col B étant 2...)
' Ici la procédure doit commencer à la 54ème colonne et se finir à la 88
' 7 est le n° de la colonne du mois JAN-2013, 9 le dernier mois
For I = 7 To 9
If Cells(J, ColonneMETIER).Value = "BOUCHER" Or Cells(J, ColonneMETIER).Value = "ELECTRICIEN" _
Or Cells(J, ColonneMETIER).Value = "SOUDEUR" Then
'INDICE 1 Ci-dessous le tableau qui copie la valeur DATE
Lg = Lg + 1
.Cells(Lg, "A").Resize(1, 8) = Array(Range("A" & J), Range("B" & J), Range("C" & J), Range("D" & J), Range("E" & J), _
Cells(J, ColonneMETIER), Cells(1, I), Cells(J, I))
End If
Next I
Next J
End With
MsgBox ("Fin de la procédure")
End Sub