Discussion :

[b.amine]

Bonjour,
vous m'avez beaucoup aidé pour mon projet j'ai essayé mais je n'arrive pas à faire ce que je veux c'est un peu normale ça ne fait meme pas deux semaine que j'ai commencé à bidouiller en excel(tout débutant)
alors je demande à l'utilisateur de préciser le fichier où figurent les données via une input box
après je veux en 1: récuperer dans un fichier protégé en écriture le nb de références pour celà il faut scanner la feuille "Liste de références" à la recherche de la cellule contenant la chaine de caractères "Nombre de référence*"(des fois c'est au singulier) et récuperer la valeur dans la cellule à sa gauche ça va être avec avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
dim nb_ref as integer
dim cellule as range
For each cellule In 'comment dire la feuille Liste de références?
 if exact("Désignation",cellule.offset(i,j))=true then nb_refcellule.offset(0,1).value

En 2: dans la feuille Matière
Je compte le nombre de cellules de couleur cyan qui sont en dessous de la cellule contenant la CDC "désignation" je les met dans nb_lignes et après je les copie dans la feuille "Donnees" de l'autre fichier où l'utilisateur travail(c'est là o`servirait nb_ligne pour la boucle for.
En 3: Je copie nb_ref fois les cellules en dessous de celles contenant la cdc "QTE" en sautant à chaque fois d'une colonne (entre deux colonnes quantité QTE il y a une colonne prix qui ne m'intérésse pas)
voilà rien que ça au début je voulais créer un tableau 2D ou je met toutes ces données mais j'ai des pb avec ReDim preserve et surtout que mon désir de ne pas ouvrir avec activesheet des milier de fois les fichiers.. il y à sur le forum pour que toutes ces copy-past se passent sans qu'on se rendent compte avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

j'ai un peu honte de vous monter ce que j'ai fait pour copier les feuilles et autres actions qui n'ont pas marchés.Mais comme ça fait deux jours que je rame et le boss (je suis stagiaire) a perdu toute patience...Merci d'avance

[b.amine]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'chercher "Désignation" dans la feuille "Matière"et renvoyer son adresse
Dim Ligne As Integer
Dim Colonne As Integer
Dim Add_Designation As String
Dim Add_QTE As String
Dim i As Integer
Dim Cellule_designation As Range
Dim Cellule_QTE As Range
Dim nb_ligne As Integer
 
 
'l'adresse de la cellule ayant la cdc "Désignation"
For Each Cells In Worksheet("Matière")
    If exact("Désignation", Cells.Value) = True Then Add_Designation = Cells.AddressLocal(False, False, xlA1, False)
    End If
Next
 
'identifier la cellule cible
Cellule_designation = Range(Add_Designation, Add_Designation)
 
'Compter le nombre de ligne en comptant le nb de cellule cyan
For Each Cellule In Cellule_designation
    If Cellule.Interior.ColorIndex = 24 Then 'cyan
        nb_lignes = nb_ligne + Cellule.Count
    End If
Next
 
'copier la colonne Désignation
For i = 0 To nb_ligne
    Worksheets("Matière").Cellule_designation.Offset(i, 0).Copy _
    Destination:=ActiveWindow.ActivatePrevious.Worksheets("Données").Range("A1").Offset(i, 0)
Next i
'===============================================================================================
'pour les colonnes qui contiennent QTE j'aimerais renvoyer avec match la première occurence de QTE et après copier toute la colonne, du coup je pourrais sauter d'une colonne QTE àune autre avec offset(0.2*i) 
 
 
 
For i = 0 To nb_ligne
    Worksheets("Matière").Cellule_QTE.Offset(i, 0).Copy _
    Destination:=ActiveWindow.ActivatePrevious.Worksheets("Données").Range("A1").Offset(i, j)
Next i
 
 
End Sub
'For Each Cellule In
'    If Cellule.Interior.ColorIndex = 24 Then 'cyan
'        nb_lignes = nb_ligne + Cellule.Count
'    End If
' Next
' Cellule_QTE = Range(Add_QTE, Add_QTE)

[b.amine]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Chercher_QTE_copie_colonne()
 
    'chercher "Désignation" dans la feuille "Matière"et renvoyer son adresse
    Dim Ligne As Integer
    Dim Colonne As Integer
    Dim Add_Designation As String
    Dim Add_QTE As String
    Dim i As Integer
    Dim Cellule_designation As Range
    Dim Cellule_QTE As Range
    Dim nb_ligne As Integer
    Dim ligne_QTE As Range
 
 
    'l'adresse de la cellule ayant la cdc "Désignation"
    For Each Cells In Worksheet("Matière")
        If exact("Désignation", Cells.Value) = True Then Add_Designation = Cells.AddressLocal(False, False, xlA1, False)
        End If
    Next
 
    'identifier la cellule cible
    Cellule_designation = Range(Add_Designation, Add_Designation)
 
    'Compter le nombre de lignes de la colonne en comptant le nb de cellule de couleur cyan
    For Each Cellule In Cellule_designation
        If Cellule.Interior.ColorIndex = 24 Then 'cyan
            nb_lignes = nb_ligne + Cellule.Count
        End If
    Next
 
    'copier la colonne Désignation
    For i = 0 To nb_ligne
        Worksheets("Matière").Cellule_designation.Offset(i, 0).Copy _
        Destination:=ActiveWindow.ActivatePrevious.Worksheets("Données").Range("A1").Offset(i, 0)
    Next i
    '===============================================================================================
 
    'trouver l'adresse de la première occurence de QTE dans la ligne 2
    'copier la colonne QTE
 
    Set ligne_QTE = Worksheets("Matière").Range("A2").EntireRow
    Cellule_QTE = Worksheets("Matière").Range("A2").Offset(0, WorksheetFunction.Match("QTE", ligne_QTE, 0) - 1)
 
    For j = 1 To nb_ref
        For i = 0 To nb_ligne
            Cellule_QTE.Offset(0, 2 * i).Copy _
            Destination:=ActiveWindow.ActivatePrevious.Worksheets("Données").Range("A1").Offset(i, j)
        Next i
Next j
 
End Sub