Copier/coller et variables multiples

[wild7]

Bonjour tout le monde,

Je viens demander de l'aide sur une de mes macros qui me cause pas mal de problèmes. Je vous explique le truc :

J'ai un fichier où j'ai traité et analysé des données venant d'une base de données de notre serveur interne et qui me donnent des résultats. J'ai créé un deuxième fichier de "synthèse" qui est un tableau récapitulatif simplifié de ces résultats.

Or, les données importées ne concernent que les 3 derniers mois contre les 3 dernières années pour la synthèse. Et je cherche à copier/coller mes résultats depuis le premier fichier vers le fivhier synthèse.

Voilà ma macro :

Sub synthèse()
For j = 2 To 1000
If InStr(1, Cells(j, 2), "XXX", vbTextCompare) <> 0 Then
Windows("classeur1.xls").Activate
Cells(j, 16).Select
Selection.Copy
Windows("synthèse.xls").Activate
Sheets("noms").Activate
Cells(32, 6).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows("classeur1.xls").Activate
Cells(j, 12).Select
Selection.Copy
Windows("synthèse.xls").Activate
Sheets("noms").Activate
Cells(31, 6).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next j


For i = 2 To 10
If InStr(1, Cells(i, 2), "YYY", vbTextCompare) <> 0 Then
Windows("classeur1.xls").Activate
Cells(i, 16).Select
Selection.Copy
Windows("synthèse.xls").Activate
Sheets("noms").Activate
Cells(34, 6).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows("classeur1.xls").Activate
Cells(i, 12).Select
Selection.Copy
Windows("synthèse.xls").Activate
Sheets("noms").Activate
Cells(33, 6).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next i
End sub

Grosso modo, si le mot (valeur) XXX si trouve dans le premier fichier, deux résultats vont sur le fichier "synthèse". Mais avec mon système, seule la première boucle fonctionne (celle avec la variable "j") et je ne comprends pas pourquoi cela ne fonctionne pas avec la seconde (en sachant que j'en ai une bonne centaine à traiter...). Je suis vraiment bloqué et vient donc chercher de l'aide auprès de vous.

Merci d'avoir pris le temps de me lire et de me donner des idées si vous voyez d'où vient le problème.

 

[Guest]

Re : Copier/coller et variables multiples

Bonjour Wild7,

Déjà avec une écriture plus claire, qui évite les allers et retours incessants d'un classeur à l'autre et sans sélection des cellules, comme dans l'exemple ci-dessous (pour une seule boucle), il est plus facile de repérer les erreurs.
Les noms en vert sont à adapter à ta situation

Sub Boucle()
    Dim ShFrom As Worksheet, shTo As Worksheet
 
    'Référence à la feuille provenance des données
    Set ShFrom = Workbooks("classeur1.xls").Sheets ("[COLOR=yellowgreen][B]LaFeuilleProvenance[/B][/COLOR]")
 
    'Référence à la feuille destination des données
    Set shTo = Workbooks("synthèse.xls").Sheets("[COLOR=yellowgreen][B]LaFeuilleDestination[/B][/COLOR]")
 
    For j = 2 To 1000
        If InStr(1, Cells(j, 2), "XXX", vbTextCompare) <> 0 Then
           'copie des valeurs de la feuille provenance à la feuille destination
            shTo.Cells([COLOR=red]32[/COLOR], 6).Value = ShFrom.Cells(j, 16).Value
            shTo.Cells([COLOR=red]31[/COLOR], 6).Value = ShFrom.Cells(j, 12).Value
        End If
    Next j
 
End Sub

Une chose apparaît dans le code qui me semble curieuse:
les cellules de destination ne changent jamais d'adresse.
Donc, en parcourant les lignes 2 à 1000, en fin de boucle la cellule destination contient seulement la dernière valeur rencontrée correspondant à la condition.

De plus on ne sait pas sur quel classeur, ni sur quelle feuille on se trouve au départ.

A bientôt

 

[wild7]

Re : Copier/coller et variables multiples

Merci beaucoup Hasco. Effectivement ça fonctionne beaucoup mieux.
Pour les cellules de destination c'est normal, le tableau est fixe contrairement au tableau de départ.

En tout cas, ça fonctionne très bien comme ça. Merci beaucoup pour la boucle, j'avoue que je m'y perdais pas mal dans mon écriture mais je n'ai que de faibles connaissances en VBA.

Merci pour tout.

A bientôt.