Discussion :

[leronce]

bonsoir au forum
je parcours 2 feuilles (S1 & S2) avec condition "Tb(x,18)>0", si oui, inscrit sur une 3 ème feuille (S7), une partie de la ligne source

l'utilisation de "Sel" (lignes 9 & 10) m'est obligatoire au bon fonctionnement de ma sous-proc, mais je doute (comme d'hab) fortement de cette obligation

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
1         Set S7 = Sheets(7)
2     For Each S In Worksheets(Array(1, 2))
3         Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
4         Tb = S.Range("B1:S" & Nbl_12)
5             For x = 2 To UBound(Tb, 1)
6                 If Tb(x, 18) > 0 Then                                           'montant don
7                 i = S.Range("B" & x).FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
8                 Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
9                 Sel = S.Range("B" & x & ":S" & x)
10                S7.Range("A" & Nbl7 & ":R" & Nbl7) = Sel
11                S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
12                End If
13            Next x
14    Next S

alors propositions d'amélioration me seraient agréables
merci de m'avoir lu

[Invité]

Tu peux tout simplement écrire:

Code :

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

S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x)

à la place de:

Code :

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

1
2
Sel = S.Range("B" & x & ":S" & x)
S7.Range("A" & Nbl7 & ":R" & Nbl7) = Sel

et ta variable disparait.

[Qwazerty]

Salut

Voila quelques propositions de modification.

A mon sens la modification la plus importante est celle concernant la précision du classeur sur lequel le code est appliqué, en cas de changement de classeur actif, la macro continuerait à dérouler en modifiant les cellule du nouveau classeur.

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
Dim Thecell As Range
    'Pour éviter les ennuis, il vaut mieux toujours préciser sur quel classeur tu travailles.
    Set S7 = ThisWorkbook.Sheets(7)
    For Each S In ThisWorkbook.Worksheets(Array(1, 2))
        'Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
        'Tb = S.Range("B1:S" & Nbl_12)
        'For x = 2 To UBound(Tb, 1)
        For Each Thecell In S.Range("B1", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
            'If Tb(x, 18) > 0 Then                                           'montant don
            If Thecell.Offset(, 17) > 0 Then 'il faudra peut-être corriger la valeur de l'offset)
                i = Thecell.FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                'Si Sel n'est utilisé qu'une seule fois par la suite, tu peux intégrer "sa formule" directement dans la suite du code
                'Sel = S.Range("B" & x & ":S" & x)
                'Pour éviter de déclarer plein de variables NB12, NB17,... il est possible d'utiliser la structure With
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                    .Value = S.Range("B" & x & ":S" & x)
                    .Interior.ColorIndex = i
                End With
            End If
        Next x
    Next S

Comme précisé dans le code modifié, il faudra sans doute corriger l'offset appliquer à la plage Thecell (If Thecell.Offset(, 17) > 0 Then), car je me fait toujours avoir avec les plages qui commencent à 0 ou à 1 :p

++
Qwaz

[leronce]

merci à vous deux pour vos réponses

@vcottineau
ta proposition ne fonctionne pas, c'était pour cela que je passais par une intermédiaire

@Qwazerty
j'explore ta proposition, sans résultat pour l'instant (hi)
je vois qu'elle parcourt toutes les cellules de chaque colonne
je joue avec les offset, ensuite comprendre .. c'est pas encore gagné

je marque résolu, l'obstination fait partie de mes heu défauts/qualités

[Qwazerty]

Salut

Quand tu dis que la proposition de vcottineau ne fonctionne pas, quelle est l'erreur?

Essai en ajoutant la propriété visé

Code :

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

S7.Range("A" & Nbl7 & ":R" & Nbl7).value = S.Range("B" & x & ":S" & x).value

Pour mon code, j'ai fais deux erreur désolé.

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
Dim Thecell As Range
    'Pour éviter les ennuis, il vaut mieux toujours préciser sur quel classeur tu travailles.
    Set S7 = ThisWorkbook.Sheets(7)
    For Each S In ThisWorkbook.Worksheets(Array(1, 2))
        'Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
        'Tb = S.Range("B1:S" & Nbl_12)
        'For x = 2 To UBound(Tb, 1)
    '1ere erreur tu ne veux boucler que sur la colonne S en utilisant la colonne B uniquement pour définir le nombre de ligne
    'Ca modifie le reste du code car TheCell représente maintenant les cellules de la colonne S (est non B)
        For Each Thecell In S.Range("S1", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
            'If Tb(x, 18) > 0 Then                                           'montant don
            If Thecell > 0 Then 'il faudra peut-être corriger la valeur de l'offset)
                i = Thecell.FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                'Si Sel n'est utilisé qu'une seule fois par la suite, tu peux intégrer "sa formule" directement dans la suite du code
                'Sel = S.Range("B" & x & ":S" & x)
                'Pour éviter de déclarer plein de variables NB12, NB17,... il est possible d'utiliser la structure With
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                '2ème erreur
                    .Value = Thecell.Offset(, -17).Resize(1, 18)
                    .Interior.ColorIndex = i
                End With
            End If
        Next x
    Next S
 
End Sub

Si tu as une version plus complète du code pour pouvoir tester le résultat n'hésite pas à la poster, si tu veux plus d'info sur le code, des passage que tu ne comprend pas, n'hésite pas non plus, le forum est fait pour ça.

Bon courage
++
Qwaz

[leronce]

Code :

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

S7.Range("A" & Nbl7 & ":R" & Nbl7).value = S.Range("B" & x & ":S" & x).value

impeccable, ça fonctionne

quant à ta 1ère proposition, après coup, j'avais trouvé l'origine
pour la 2ème, hormis colorindex, je n'ai rien
à moi de comprendre l'alliance offset & resize

pour un code plus complet ... hi! plus de 300 lignes répartis en 18 proc, sur lesquelles je travaille pour les alléger & améliorer.
j'ai commencé avec 652 lignes, je suis donc sur la bonne voie

[Qwazerty]

Salut

pour la 2ème, hormis colorindex, je n'ai rien

Donc i peut-être suprimé

Code :

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

1
2
3
4
5
6
7
8
9
10
 
           If Thecell > 0 Then
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                '2ème erreur
                    .Value = Thecell.Offset(, -17).Resize(1, 18)
                    .Interior.ColorIndex = Thecell.FormatConditions(1).Interior.ColorIndex
                End With

Si TheCell correspond à la cellule F2, avec un offset(1,5) on pointe sur la cellule K3 et avec un resize(2,3) on pointe sur la plage K3:N4.

++
Qwaz

[leronce]

cette fois-ci, vraiment résolu

@ Qwazerty: merci pour les aide, conseils & leçons
j'ai noté dans la proc, le résultat d'un offset suivi de resize pour pense-bête (hi)

modifs
je démarre en S2 pour le départ de boucle, S1 = titre colonne
i est resté
j'ai rajouté value à ".Value = Thecell.Offset(, -17).Resize(1, 18).Value"

donc code final ci-dessous

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
Sub don()
      Dim Thecell As Range, S7 As Worksheet, S As Worksheet, i As String
1      Set S7 = ThisWorkbook.Sheets(7)
2         For Each S In ThisWorkbook.Worksheets(Array(1, 2))
3             For Each Thecell In S.Range("S2", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
4                 If Thecell > 0 Then
5                     i = Thecell.FormatConditions(1).Interior.ColorIndex         'récup index couleur fond S
6                     With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
7                         .Value = Thecell.Offset(, -17).Resize(1, 18).Value
8                         .Interior.ColorIndex = i
9                     End With
10                End If
11            Next Thecell
12        Next S
End Sub