1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Private Sub Worksheet_Activate()
'définition des variables
Dim histo As String
Dim TRLThisto As Integer
Dim i As Integer
Dim j As Integer
Dim Derncol As Integer
Dim Derncoltitre As Integer
j = 2 'N° ligne Liste des onglets
i = 2 'N° ligne Histo TRLT
Do While Cells(i, 2) <> ""
'recherche de la premiere colonne vide par ligne ds la feuille Histo_TRLT
Derncol = (Cells(i, Cells.Columns.Count).End(xlToLeft).Column) + 1
histo = Cells(i, 1).Value 'récupère la valeur "Référence" de la feuille histo
TRLThisto = Cells(i, Derncol - 2) 'récupère la derniere valeur TRLT de la feuille histo
'MsgBox (TRLThisto)
While Sheets("Liste des onglets").Cells(j, 1) <> "" ' parcours le tableau de la feuille Liste des onglets
If Sheets("Liste des onglets").Cells(j, 1) = histo And Sheets("Liste des onglets").Cells(j, 3) <> TRLThisto Then 'ne recupere les données que si differentes
Cells(i, Derncol) = Sheets("Liste des onglets").Cells(j, 3) 'renvoie le TRLT dans la cellule de la premiere colonne vide de la ligne active de la feuille "Histo_TRLT
Cells(i, Derncol + 1) = CDate(Sheets("Liste des onglets").Cells(j, 7)) 'renvoie la date dans la cellule de la deuxieme colonne vide de la ligne active de la feuille "Histo_TRLT
End If
j = j + 1
'DernLigneliste = Sheets("Liste des onglets").Range("A" & Rows.Count).End(xlUp).Row 'compte les lignes de la liste des onglets
Wend
j = 2
i = i + 1
Loop
Derncoltitre = Sheets("Histo_TRLT").UsedRange.Columns.Count 'recherche numero de la premiere colonne vide de la premiere ligne sur la feuille Histo_TRLT pour coller les titres
'MsgBox (Derncoltitre)
'copier coller des titres des deux colonnes
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 3), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 2)).Select
Selection.Copy
Range(Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count - 1), Cells(1, Sheets("Histo_TRLT").UsedRange.Columns.Count)).Select
ActiveSheet.Paste
Application.CutCopyMode = False 'enleve la surbrillance copier
Columns.AutoFit 'largeur de colonnes auto
Range("A2").Select
End Sub |
Partager