[Résolu] Copier coller cellules en fonction d'une valeur commune - VBA

[Delaye]

Bonjour à tous / toutes,

Nouveau sur ce forum, j'ai pas mal cherché, mais je ne trouve pas ce que je cherche

Je dispose d'un fichier comportant 2 feuilles. Sur la feuille 1 j'ai des infos, sur la feuille 2 j'ai d'autres infos. Dans chacune de ces feuilles, j'ai une colonne avec des valeurs communes (code INSEE).
J'ai besoin de copier les valeurs des cellules E à Y depuis la feuille 2 vers la feuille 1 si le code INSEE correspond. Les infos doivent être copiées sur la feuille 1 à partir de la colonne S.
Le problème ? Je n'y arrive absolument pas ! J'ai testé un paquet de choses, je n'arrive jamais à avoir ce que je veux, soit mes boucles fonctionnent bien mais pas le reste, soit cela fait des erreurs (je fais beaucoup de php, mais je suis totalement débutant en VBA...).

Je vous joins un fichier exemple, le fichier d'origine possède environ 35000 lignes par feuille, d'où l'utilité de faire une maccro !

Merci par avance pour votre aide !

 

[Paf]

Bonjour Delaye et bienvenue sur XLD

Ca ne va pas être facile, car :
- en Feuille1 les codes INSEE sont sur 5 caractères et en feuille2 sur 4.( mais on peut s'arranger si lorsqu'on a 4 caractères on rajoute un 0 devant)
- aucun code commun entre les deux feuilles.

A+

 

[vgendron]

Hello Delaye, Paf

Voir PJ pour un début de réponse

avec des zones nommées DataOr
CodeInsee

comme le fait remarquer Paf, tes codes Insee n'ont pas le meme format entre les deux feuilles.. (et un code INSEE.. me semble que c'est un peu plus long...Sexe/annee/mois/departement/code ville naissance / Numéro / clé)

bref.. pour l'exemple j'ai retapé le code 1021 format standard

 

[Delaye]

Bonjour Paf,

Merci pour votre réponse, oui effectivement j'ai fait le fichier d'exemple à la va vite, le fichier de base possède des code commun et je rajouter le 0 devant. Je joins le bon fichier, ça sera plus simple !

Merci

 

[youky(BJ)]

Bienvenu au Forum,
Voici une petite macro qui doit faire l'affaire
J'aimerais comme toi connaitre le php, par contre je VBA c'est bon.
Ici j'utilise Feuil2 ou Feuil1 c'est le codename et non le nom de l'onglet

Sub MyCopy()
For k = 2 To Feuil2.[C65536].End(3).Row 'boucle
insee = Feuil2.Cells(k, 3)
lig = Application.Count(insee, Feuil1.[C1:C65536], 0) 'donne N°ligne si trouvé
If IsNumeric(lig) Then
'on copy si trouvé
Feuil1.Range("S" & lig & ":AM" & lig).Value = Feuil2.Range("E" & k & ":Y" & k).Value
End If
Next
End Sub

Bruno

 

[Delaye]

Bonjour vgendron et Bruno,

Merci pour vos réponses ! Je test ça de suite et je reviens vous dire si ça fonctionne bien !

 

[Paf]

re et bonjour vgendron, youki(BJ),

un essai macro à base de dictionnaire et de tableaux ( 35000 lignes à traiter !)

Sub MAJ()
Dim Tablo2, TabDonnées(1 To 21), i As Long, j As Long, Dico, Clé
Dim Tablo1, Tablo3, W1 As Worksheet, W2 As Worksheet
Set Dico = CreateObject("Scripting.Dictionary")
Set W1 = Worksheets("Feuille1") ' feuille à mettre à jour
Set W2 = Worksheets("Feuille2") ' feuille des données
Tablo2 = W2.Range("A2:Y" & W2.Range("A" & Rows.Count).End(xlUp).Row)
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    Clé = IIf(Len(Tablo2(i, 3)) = 4, "0" & Tablo2(i, 3), Tablo2(i, 3))
    For j = 5 To 25
        TabDonnées(j - 4) = Tablo2(i, j)  'Attribution des données
    Next
    Dico(Clé) = TabDonnées
Next
Tablo1 = W1.Range("C2:C" & W2.Range("A" & Rows.Count).End(xlUp).Row)
ReDim Tablo3(1 To UBound(Tablo1, 1), 1 To 21)
For i = LBound(Tablo1, 1) To UBound(Tablo1, 1)
    If Dico.exists(Tablo1(i, 1)) Then
        For j = 1 To 21
            Tablo3(i, j) = Dico(Tablo1(i, 1))(j)
        Next
    End If
Next
W1.Range("S2").Resize(UBound(Tablo3), 21) = Tablo3 'mise à jour de Feuille1
End Sub

A+

 

[Delaye]

Bonjour à tous,

J'ai eu pas mal de soucis pour faire fonctionner vos maccros et fonctions, en fait ça avait l'air de marcher plus ou moins, mais trop de ligne, excel plante; je n'ai pas pu tester sur le fichier final.
Voici une maccro qui fonctionne, cependant, au bout d'un certain temps j'ai une erreur d’exécution 1004. Il y a du mieux, mais c'est toujours pas ça ! J'ai un ami qui risque de pouvoir me dépanner, je ne vais pas vous embêter plus !

Sub MacroStar()

a = 2
b = 2


start:
Do
Sheets("Feuille2").Select
If Cells(a, 3) = Sheets("Feuille1").Cells(b, 3) Then
Sheets("Feuille2").Select
Range(Cells(a, 5), Cells(a, 26)).Select
Selection.Copy
Sheets("Feuille1").Select
Cells(b, 19).Select
ActiveSheet.Paste
GoTo Jump:
Else
b = b + 1
End If
Loop Until b = 36572
Jump:
a = a + 1
If a >= 27028 Then
GoTo finish:
Else
GoTo start:
End If

finish:
MsgBox ("Here we go!!!")
End Sub

Bonne journée

 

[Paf]

Re,

en fait ça avait l'air de marcher plus ou moins, mais trop de ligne, excel plante

Avec de telles précisions, on va certainement pouvoir améliorer !!!

pour quelle code ?
ça marche ou ça marche pas ?
excel plante , oui, mais où? quel est le message d'erreur ?

Pourquoi nous demander de dépanner un code venu d'on ne sait où (autre forum?) qui présente ( ?)les mêmes symptômes que nos propositions et qui risque d'être long à l'exécution ?

A+

 

[Delaye]

Re Paf,

Alors en fait, le code que tu avais fait dans le premier doc que tu m'as fait passé marche, par contre je n'arrive pas à l'étendre à tout mon doc, ça fini par planter, j'ai essayé de faire bout par bout mais pas de solution, ça plante à chaque fois.

Pour :

Sub MyCopy()
For k = 2 To Feuil2.[C65536].End(3).Row 'boucle
insee = Feuil2.Cells(k, 3)
lig = Application.Count(insee, Feuil1.[C1:C65536], 0) 'donne N°ligne si trouvé
If IsNumeric(lig) Then
'on copy si trouvé
Feuil1.Range("S" & lig & ":AM" & lig).Value = Feuil2.Range("E" & k & ":Y" & k).Value
End If
Next
End Sub

Je n'ai pas réussi à le faire fonctionner, idem pour :

Sub MAJ()
Dim Tablo2, TabDonnées(1 To 21), i As Long, j As Long, Dico, Clé
Dim Tablo1, Tablo3, W1 As Worksheet, W2 As Worksheet
Set Dico = CreateObject("Scripting.Dictionary")
Set W1 = Worksheets("Feuille1") ' feuille à mettre à jour
Set W2 = Worksheets("Feuille2") ' feuille des données
Tablo2 = W2.Range("A2:Y" & W2.Range("A" & Rows.Count).End(xlUp).Row)
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
Clé = IIf(Len(Tablo2(i, 3)) = 4, "0" & Tablo2(i, 3), Tablo2(i, 3))
For j = 5 To 25
TabDonnées(j - 4) = Tablo2(i, j) 'Attribution des données
Next
Dico(Clé) = TabDonnées
Next
Tablo1 = W1.Range("C2:C" & W2.Range("A" & Rows.Count).End(xlUp).Row)
ReDim Tablo3(1 To UBound(Tablo1, 1), 1 To 21)
For i = LBound(Tablo1, 1) To UBound(Tablo1, 1)
If Dico.exists(Tablo1(i, 1)) Then
For j = 1 To 21
Tablo3(i, j) = Dico(Tablo1(i, 1))(j)
Next
End If
Next
W1.Range("S2").Resize(UBound(Tablo3), 21) = Tablo3 'mise à jour de Feuille1
End Sub

Du coup j'ai utilisé la macro que j'ai mise plus haut (MacroStar). Maintenant il me fait l'erreur "erreur d’exécution '1004': erreur définie par l'application ou par l'objet. et ça ce produit pas dès le début, il fait tourner la macro puis ça plante. J'ai donc essayé en mode pas-à-pas, le message d'erreur apparaît au niveau de :

If Cells(a, 3) = Sheets("Feuille1").Cells(b, 3) Then

Là je pense qu'il y a tout en détail ! J'essai de voir aussi avec un ami, si jamais il trouve je vous tiens au courant.

Merci en tout cas

 

[Paf]

Re,

Là je pense qu'il y a tout en détail !

ben non!!

à part la copie des codes proposés et la répétition que ça ne marche pas , rien qui puissent nous permettre de corriger.

D'autant que les anomalies se produisent sur un code adapté à un fichier que nous ne connaissons pas !

J'essai de voir aussi avec un ami...

Oui c'est mieux ; il aura de visu et le code modifié et le classeur réel.

Bonne suite

 

[pierrejean]

Bonjour à tous

Un essai

 

[Delaye]

Re !

Ci-joint le fichier en question, comme ça tu peux te rendre compte à quoi est adapté la macro. J'ai eu mon pote, à priori il va pouvoir débuguer tout ça, mais certainement pas aujourd'hui.

Désolé si je ne donne pas tout ce qu'il faut, mais j'avoue que à ce niveau là, ça me dépasse

 

[Paf]

re,

Dans le premier classeur joint, on avait des N° Insee sur 5 caractères en feuille1 et sur 4 en feuille2. il y avait une correction dans mon code pour rajouter un 0 aux codes à 4 caractères.

Dans le deuxième les deux feuilles sont identiques sur les deux feuilles: 5 caractères sauf pour les 9 premiers départements pour lesquels le 0 du début est supprimé donc 4 caractères.

La correction à apporter:

remplacer:

Clé = IIf(Len(Tablo2(i, 3)) = 4, "0" & Tablo2(i, 3), Tablo2(i, 3))

par

 Clé = Tablo2(i, 3)

Résultat en un peu moins de 6 secondes sur mon vieux PC.

A+

 

[Delaye]

ça marche !!!
Merci beaucoup Paf, j'ai du convertir les 2 colonnes en nombre pour que ça prenne la totalité des codes INSEE en compte, mais le résultat est là !
Merci a vous tous pour vos réponses !

A bientôt