Importation d'informations
Résolu
Sandrine
-
Sandrine -
Sandrine -
Bonjour,
Je vous explique ma situation.
J'ai un document A et un document B.
Qui sont pour la forme identique.
Donc le ficher A est un ficher récent et le B plus anciens. J'ai besoin de compléter mon fichier A par le B. Dans ma colonne A j'ai mes ITM (référence produit).
Je veux que chaque cellule, de mon fichier A, de ma colonne A soit recherché dans mon fichier B ( dans la colonne A aussi) et si il y a correspondance copier les cellule de cette ligne en (K,L,M,N,O) et les colles dans mon ficher A. Donc j'aurai un fichier complet.
Voila mon début de code:
MERci
Je vous explique ma situation.
J'ai un document A et un document B.
Qui sont pour la forme identique.
Donc le ficher A est un ficher récent et le B plus anciens. J'ai besoin de compléter mon fichier A par le B. Dans ma colonne A j'ai mes ITM (référence produit).
Je veux que chaque cellule, de mon fichier A, de ma colonne A soit recherché dans mon fichier B ( dans la colonne A aussi) et si il y a correspondance copier les cellule de cette ligne en (K,L,M,N,O) et les colles dans mon ficher A. Donc j'aurai un fichier complet.
Voila mon début de code:
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de colonnes)
Set CD = ThisWorkbook 'définit la classeur destination CD
With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue permettant l'ouverture d'un fichier
.Show 'ouverture
On Error GoTo fin 'en cas d'erreur, va à l'étiquette "fin"
Workbooks.Open (.SelectedItems(1)) 'ouvre le premier fichier sélectionné et ferme la boîte de dialogue (génère une erreur si bouton [Annuler])
End With 'fin de la prise en compte de la boîte de dialogue permettant l'ouverture d'un fichier
Set CS = ActiveWorkbook
TV = Range("A1").CurrentRegion
NL = UBound(TV, 1)
NC = UBound(TV, 2)
End Sub
MERci
A voir également:
- Importation d'informations
- Entrer les informations d'identification reseau - Guide
- Reconsidérer le traitement de vos informations à des fins publicitaires - Accueil - Réseaux sociaux
- Vous n'avez pas fourni assez d'informations pour que google puisse s'assurer que ce compte vous appartient. google vous demande ces informations afin de protéger votre compte. - Guide
- Dédouanement à l'importation terminé - Forum Consommation & Internet
- Pour plus d’informations, contactez votre administrateur système. - Forum Windows
1 réponse
Bonjour,
quelques modifs de votre code et des lignes en plus
quelques modifs de votre code et des lignes en plus
Sub Macro1()
Dim Dico_Data As Object, PlageA, PlageB, derlig1, x, Fin
'Application.ScreenUpdating = False
'fichier A
Set Dico_Data = CreateObject("Scripting.Dictionary")
With Worksheets("feuil1")
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A
PlageA = .Range("A2:A" & derlig1) 'mise en memoire
End With
'boucle sur plage
Fin = UBound(PlageA, 1) 'longueur table
For x = 1 To Fin
Dico_Data(PlageA(x, 1)) = x + 1 'mise en memoire ref et ligne ref dans dictionnaire---->x+1 pour ligne 2
Next x
'ouverture et recup fichier B
Application.FileDialog(msoFileDialogOpen).Filters.Add "Excel files (*.xlsx)", "*.xlsx", 1 'prend en compte la boîte de dialogue permettant l'ouverture d'un fichier
If Not (Application.FileDialog(msoFileDialogOpen).Show) Then
MsgBox "Pas de fichier selectionne !!!!!.", vbExclamation, "PAS BIEN !!!!!!!!"
Application.ScreenUpdating = True
Exit Sub
End If
With Application.FileDialog(msoFileDialogOpen)
Workbooks.Open (.SelectedItems(1)) 'ouvre le premier fichier sélectionné et ferme la boîte de dialogue (génère une erreur si bouton [Annuler])
nom_Fichier = Right(.SelectedItems(1), Len(.SelectedItems(1)) - InStrRev(.SelectedItems(1), "\")) 'nom de fichier avec extention
End With
With Workbooks(nom_Fichier).Worksheets("feuil1")
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A
PlageB = .Range("A2:O" & derlig1) 'mise en memoire plage de cellules fichier B
End With
Fin = UBound(PlageB) 'nombre de "ligne"
Workbooks(nom_Fichier).Close False
'retour fichier A
With Worksheets("feuil1")
For x = 1 To Fin
If Dico_Data.exists(PlageB(x, 1)) Then 'ref existe en A et B
Lg = Dico_Data(PlageB(x, 1)) 'ligne ref fichier A
.Range("K" & Lg) = PlageB(x, 11) 'ecriture des infos
.Range("L" & Lg) = PlageB(x, 12)
.Range("M" & Lg) = PlageB(x, 13)
.Range("N" & Lg) = PlageB(x, 14)
.Range("O" & Lg) = PlageB(x, 15)
End If
Next x
End With
Application.ScreenUpdating = True
End Sub
Sandrine
C'est parfait merci beaucoup =)
