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
| Sub Extraction_donnee_CCR()
'adresse = ActiveCell.Address recuperation donnée cellule
'ligne = ActiveCell.Row recuperation numero de ligne
'
' Extraction_donnee_CCR Macro
' Macro enregistrée le 17/11/2011 par T0116493
'
'analyser le contenu de la cellule A2 de la premiere page ( page numéro 7'
Dim produit, feuille As String
Dim a, b, c, final As Integer
feuille = LastNameSheet 'nom e la derniere feuille du fichier
var1 = 7 'numero de feuille'
var2 = 7 'colonne'
var3 = 0 'a completer'
'recupere le nom du 1er tube'
Worksheets("var1").Cells(2, a).Value = produit
'verifie si l'on a atteint la derniere colonne a verifier'
Do Until var2 = 251 Or final = 1
'verifie si l'on a pas atteint la derniere feuille nomme Fin'
If ActiveSheet.Name = Fin Then
final = 1
End If
'verifie que le tube n'existe pas deja'
If produit = Worksheets("Top20 répartition h MO").Cells(1, var2).Value Then
UserForm1.Show
Else
'se positionne a la derniere cellule vide sur la ligne 1 en partant de droite et y recopie la valeur de "produit"
[IV1].End(xlToLeft).Offset(0, 1) = produit
'incrémente les colonnes pour changer de colonne'
var2 = var2 + 4
End If
Loop
'reinitialise les colonnes pour commencer un nouveau tube'
var2 = 7
MsgBox "Recopie des tube terminé"
End Sub |
Partager