VBA Copier Coller vers cellules precises avec des ranges aleatoires

**thibault12500** · 12/12/2013, 15h23

Bonjour,

Je suis un debutant en VBA et je bloque sur un sujet.
Dans un fichier excel j'ai :
- un onglet "toto"
- un onglet "lala"

Via un TCD dans l'onglet "lala" j'obtiens des donnees que je souhaite modifier. (Les donnees ne font pas partis du TCD)

Ensuite, voila mon probleme : je veux que ces donnees modifiees aillent se coller au bon endroit dans l'onglet "toto" a la fin des modifications. Le lien que j'ai pour cela c'est un numeros commun.

Ma plage de donnees a copier sur l'onglet "lala'" va de M13 a U13 mais varie sur le nombre de lignes suivant les criteres du TCD.
Ma plage de donnees pour coller sur l'onglet "toto'" va de EI3 a EQ3 mais varie sur le nombre de lignes.

Le lien en commun que j'ai entre les onglets "toto" et "lala" est un numeros qui se trouve pour "toto" a EH3 jusqu'a XX (Cela varie) et pour "lala" a L13 jusqu'a XX (cela depend du TCD)

Comment faire pour aller copier au bon endroit tout en gerant ce probleme de variation des donnees ? Je suis completement perdu je ne sais meme pas par quoi commencer sur mon code...

Votre aide m'est precieuse! Merci pour ceux qui veulent s'y pencher dessus.

**nibledispo** · 12/12/2013, 16h38

Bonjour,

Sans fichier ni code il est difficile de se faire une idée.
Toutefois, une solution peut-être : Donner un nom aux cellules devant recevoir les modifications. Cela simplifie souvent les choses.

Cordialement,

**thibault12500** · 12/12/2013, 17h20

Effectivement sans piece jointe c'est delicat mais mon fichier est tres tres lourd. J'ai fait un code deja mais il ne marche pas. Peut etre qu'il vous eclairera un peu plus sur ce que je souhaite.

Merci de votre aide

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
 
Sub Copier_Valeurs()
 
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, C As Range
Dim LigneAjout As Long
 
Application.ScreenUpdating = False
 
Set WsS = Worksheets("lala")
Set WsC = Worksheets("toto")
 
For Each Cel In WsS.Range("L12:L" & WsS.Range("L" & Rows.Count).End(xlUp).Row)
 
Set C = WsC.Columns(138).Find(Cel, , xlValues, xlWhole)
LigneAjout = WsC.Range("L" & Rows.Count).End(xlUp).Row + 1
 
If C Is Nothing Then
Cel.Resize(, 9).Copy
WsC.Range("L" & C.Row).PasteSpecial (xlPasteValues)
 
Else
Cel.Resize(, 16).Copy
WsC.Range("A" & LigneAjout).PasteSpecial (xlPasteValues)
LigneAjout = LigneAjout + 1
End If
 
Next Cel
 
Application.CutCopyMode = False
 
Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing
 
End Sub

**thibault12500** · 13/12/2013, 11h31

Bonjour,
J'ai travaille sur mon code mais cela ne fonctionne toujours pas...

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
Sub Copier_Valeurs()
 
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, C As Range
Dim LigneAjout As Long
 
Application.ScreenUpdating = False
 
Set WsS = Worksheets("lala")
Set WsC = Worksheets("toto")
 
For Each Cel In WsS.Range("L12:L" & WsS.Range("L" & Rows.Count).End(xlUp).Row)
 
Set C = WsC.Columns(138).Find(Cel, , xlValues, xlWhole)
LigneAjout = WsC.Range("EH" & Rows.Count).End(xlUp).Row + 1
 
If C Is Nothing Then
Cel.Resize(, 9).Copy WsC.Range("EH" & C.Row)
 
Else
Cel.Resize(, 9).Copy WsC.Range("EH" & LigneAjout)
LigneAjout = LigneAjout + 1
End If
 
Next Cel
 
Application.CutCopyMode = False
 
Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing
 
End Sub

HELP!!! Je m'y suis vraiement penche dessus mais sans resultat...

Merci de votre aide

**nibledispo** · 14/12/2013, 05h40

Bonjour,

difficile de savoir exactement ce que tu attends.

en tout cas le code suivant (basé sur le tien) renvoie bien dans toto les lignes dont les cellules de la colonne "L" de "lala" ne sont pas présentes dans colonne "EH" de "toto".

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
 
Sub Copier_Valeurs2()
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, C As Range
Dim LigneAjout As Long
 
Application.ScreenUpdating = False
 
Set WsS = Worksheets("lala")
Set WsC = Worksheets("toto")
 
For Each Cel In WsS.Range("L12:L" & WsS.Range("L" & Rows.Count).End(xlUp).Row)
    On Error Resume Next
    Set C = WsC.Columns(138).Find(Cel, , xlValues, xlWhole)
    MsgBox C.Address
    LigneAjout = WsC.Range("EH" & Rows.Count).End(xlUp).Row + 1
 
    If C Is Nothing Then
        Cel.Resize(, 10).Copy WsC.Range("EH" & LigneAjout)
        LigneAjout = LigneAjout + 1
       Else
        'Cel.Resize(, 10).Copy WsC.Range("EH" & C.Row)
    End If
Next Cel
 
Application.CutCopyMode = False
 
Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing
End Sub

Cordialement,

**thibault12500** · 14/12/2013, 19h39

Bonjour nibledispo et encore merci de ton aide.

Je peux pas essayer ton code car j'ai pas le fichier actuellement.

Par contre ce que je souhaite c'est que les lignes de "lala" qui sont modifiées aillent ensuite se copier dans "toto" via le numéro commun qu'on a dans la colonne L pour "lala" et EH pour "toto". Elle écraseront les données précédentes qu'on avait dans "toto".
En fait, je veux juste qu'elles aillent se copier au bon endroit grâce au numéro en commun qu'on a sur les 2 onglets.

J'espère que c'est plus clair. Tu crois qu'on peut adapter ton code pour faire ça?

Merci de ton aide en tout cas.

**nibledispo** · 14/12/2013, 21h16

Bonsoir,

regarde si le fichier joint répond à ton attente.

La feuille lala a :
- deux enregistrements 15 et 16 qui n'existent pas dans toto
- subie des modifications en rouge sur deux enregistrements existants dans toto

résultat:
- les deux enregistrements inexistants sont rajoutés dans toto
- les enregistrements modifiés sont remplacés dans toto

Cordialement,

**thibault12500** · 16/12/2013, 14h20

Bonjour nibledispo,

D'abord merci bcp pour ton aide! par contre le temps de traitement dure longtemps car je pense que j'ai trop de lignes dans ma base de donnee "toto" (environ 8000).

Alors je pense changer de strategie et finalement partir uniquement sur un remplacage de ligne dans la base "toto". Il faudrait que j'annule l'option de rajouter une ligne au cas ou il ne trouve pas la ligne, peut etre que je gagnerai en temps de traitement.

Je pensais le faire de cette sorte, mais cela ne marche pas... Probleme de synthaxe il me dit

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
 
Sub Copier_Valeurs2()
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, C As Range
 
Application.ScreenUpdating = False
 
Set WsS = Worksheets("lala")
Set WsC = Worksheets("toto")
 
For Each Cel In WsS.Range("L12:L" & WsS.Range("L" & Rows.Count).End(xlUp).Row)
    On Error Resume Next
    Set C = WsC.Columns(138).Find(Cel, , xlValues, xlWhole)
 
C = Cel.Resize(, 10).Copy WsC.Range("EH" & C.Row) 'probleme de synthaxe la!
 
Next Cel
 
Application.CutCopyMode = False
 
Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing
 
End Sub

Sinon, y a-t-il d'autres moyen pour reduire de temps de traitement ?

Merci de ton aide.

**nibledispo** · 16/12/2013, 16h14

Bonjour,

je sors de chez le dentiste avec une douleur qui paralyse mes méninges.

Qu'entends-tu par longtemps ?

Une solution serait de travailler sur des variables tableau.

Pour ce faire transférer les données source dans une variable tableau:

Variable tableau = donnée source

A plus tard si tu n'obtiens pas de réponse satisfaisante avant.

Cordialement,

**thibault12500** · 16/12/2013, 17h29

Longtemps : je veux dire plus de 1 a 2 min ca depends des modifs.

Apres pour le tableau, je ne sais pas comment faire. Mes competences, si on peut employer ce terme, sont limitees en VBA. Qu'entend tu par "tableau" sous VBA?

Je te souhaite une bonne recup!

Merci