macro copier ds 1 cellule 2 données séparées Résolu

Question

Bonjour, 
 tout d'abord merci pour la personne qui pourra m'aider.
voilà mon "problème":
je voudrais une macro qui me permettrait de copier dans une cellule, 2 données dans 2 cellules adjacentes.
je m'explique

disons que sur un classeur j'ai en A1 : nom et en B1 : prénom
je voudrais que A1+B1 soient collés ensemble (l'un au bout de l'autre) dans une cellule d'un autre classeur en A3 (par exemple).
il s'agit d'une liste de noms qui va de A1 à A38 sur le 1er classeur
et de A6 à A45 sur le second classeur

avec excel se serait concatener mais en macro, je cale.

merci d'avance

Configuration: Windows Vista / Firefox 3.6.8

michel_m · Answer

Bonjour,  

les 2 classeurs doivent être ouverts   
classeur source "classeur1.xls" feuille "feuil1") à adapter chez toi  

macro dans classeur cible (feuille où on restitue active, cad sur l'écran)

Option Base 1  
Sub concatener()  
Dim identite  
Dim cptr As Byte  

ReDim identite(38)  

With Workbooks("classeur1.xls").Sheets(1)  
    For cptr = 1 To 38  
        identite(cptr) = .Cells(cptr, 1) & " " & .Cells(cptr, 2)  
    Next  
End With  

With ActiveSheet  
    Range("A6:A45") = identite  
End With  

End Sub  
--


:-x

maguy · Answer

Tout d'abord merci d'avoir répondu !
pourrais-je avoir quelques explications sur la macro de façon a pouvoir l'adpater ni nécessaire.
 en attendant, j'essaye et je vous tiens au courant des résultats.
merci encore

maguy

maguy · Answer

re Bonjour 

erreur de ma part : les deux feuilles appartiennent au même classeur. 
pardon 
Maguy

je joins un fichier pour exemple : http://www.cijoint.fr/cjlink.php?file=cj201009/cijYs1nw7P.xlsm

maguy · Answer

Bonjour,

j'ai donc changer le code avec les informations que j'ai mis + haut et ça ne fonctionne pas.
quelqu'un peut-il m'aider ? merci d'avance

code changer

Sub concatener()
Dim identite
Dim cptr As Byte

ReDim identite(38)

With ThisWorkbook.Sheets("données")
    For cptr = 1 To 38
        identite(cptr) = .Cells(cptr, 1) & " " & .Cells(cptr, 2)
    Next
End With

With ActiveSheet
    Range("A1:A45") = identite
End With

End Sub

maguy · Answer

Bonjour,

d'accord, je met le fichier en excel 97 2003 en espérant avoir d'autres idées
merci en tout cas
Maguy

http://www.cijoint.fr/cjlink.php?file=cj201009/cij5S40sNJ.xls

etpaflechien · Answer

Bonjour, 

si une macro n'est pas indispensable tu peux utiliser la fonction concatener 

dans la feuille copie en A1 tu écris: 

=CONCATENER(données!A1;"  ";données!B1) 

puis tu dupliques vers le bas 

bon courage

Patrice33740 · Answer

Bonsoir, 

Essaie ce code : 

Sub concatener() 
Dim rng As Range 
Dim cel As Range 
Dim copie As Range 
  Set copie = Worksheets("copie").Range("A1")      '1ère cellule destination 
  Set rng = Worksheets("données").Range("A1")      '1ère cellule prénoms 
  With rng 
    Set rng = .Resize(.End(xlDown).Row - .Row + 1) 'Liste des prénoms 
  End With 
  For Each cel In rng.Cells 
   copie.Value = StrConv(cel.Value, vbProperCase) & " " & _
                 StrConv(cel.Offset(0, 1).Value, vbUpperCase)
   Set copie = copie.Offset(1) 
  Next 
End Sub
Cordialement 
Patrice 
Nicolas dit toujours : « C'est facile quand on connait la réponse ! »

maguy · Answer

Bonjour,

tout d'abord merci Patrice, le code fonctionne à merveille !
Sauf que (je me suis trompée), il faudrait que le nom soit en majuscules et le prénom avec la 1ère lettre en majuscule seulement.
Si j'essaie ce code en inversant, le copiage me met le prénom en majuscules.

pourriez-vous encore me donner un petit coup de main ?
avec tous mes remerciements
Maguy

maguy · Answer

Bonjour et merci

le code fonctionne très bien sauf (et c'est de ma faute), il faudrait :
que le nom soit en majuscule et le prénom avec la 1ère lettre en majuscule.
du style : RATEAU Pierre

en essayant avec votre code, c'est le prénom qui est en majuscules.

Merci de votre aide encore une fois
Maguy

Patrice33740 · Answer

Bonsoir,

Dans ton exemple du 5 sept à 19h19, la première colonne (A) contient le prénom et la seconde (B) contient le nom ce qui donne Marcel RATEAU !

Il semblerait que maintenant tu mettes le nom en colonne A et le prénom en colonne B, cela donnerait effectivement Rateau MARCEL !

Dans ce cas il suffit de remplacer :

   copie.Value = StrConv(cel.Value, vbProperCase) & " " & _
                 StrConv(cel.Offset(0, 1).Value, vbUpperCase)

Par

   copie.Value = StrConv(cel.Value, vbUpperCase) & " " & _
                 StrConv(cel.Offset(0, 1).Value, vbProperCase)

Sinon il suffit de remettre le prénom en premier et le nom en second !

Cordialement
Patrice

PS : Sois plus précise dans tes prochaines demandes, il a fallu deviner que tu voulais des majuscules !

Maguy · Answer

Re bonjour 

j'ai de nouveau un petit problème avec le code
un message me dit " erreur de compilation    projet ou bibliothèque introuvable"

cela "coince" ou c'est en gras!


Dim rng As Range
Dim cel As Range
Dim copie As Range
  Set copie = Worksheets("appelundi8").Range("A6:A37")      '1ère cellule destination
  Set rng = Worksheets("listeappel").Range("B4:B39")      '1ère cellule noms
  With rng
    Set rng = .Resize(.End(xlDown).Row - .Row + 1) 'Liste des prénoms
  End With
  For Each cel In rng.Cells
   copie.Value = StrConv(cel.Value, vbUpperCase) & " " & _
                 StrConv(cel.Offset(0, 1).Value, vbProperCase)
   Set copie = copie.Offset(1)
  Next

Patrice, pouvez -vous m'aider encore !
si vous avez besoin d'autres renseignements dites-le moi 
merci d'avance
Maguy

Patrice33740 · Answer

Bonjour,

Il y a une petite erreur dans ton adaptation du code ci-dessus mais je ne pense pas que ce soit la cause de l'erreur :
Remplacer :

Set copie = Worksheets("appelundi8").Range("A6:A37") '1ère cellule destination
Set rng = Worksheets("listeappel").Range("B4:B39") '1ère cellule noms 
par :

  Set copie = Worksheets("appelundi8").Range("A6") '1ère cellule destination
  Set rng = Worksheets("listeappel").Range("B4") '1ère cellule noms
Je travaille avec excel 2003, ton problème vient peut-être de la saisie sous 2007, remplace ces deux lignes :

copie.Value = StrConv(cel.Value, vbUpperCase) & " " & _
StrConv(cel.Offset(0, 1).Value, vbProperCase) 
par celle-ci :

copie.Value = StrConv(cel.Value, vbUpperCase) & " " & StrConv(cel.Offset(0, 1).Value, vbProperCase) 
Tiens moi au courant

Maguy · Answer

Bonjour,

j'ai encore un petit souci ...........de taille !
en effet en rentrant le code que Patrice m'a proposer, et qui fonctionne parfaitement, j'ai constater que mon fichier avait grossi dans des proportions "hallucinantes".

je suis passée de quelques centaines d'octets à plus de 5Mo.
n'y aurait-il pas un code moins gourmand en ressources ?
ou bien est-ce tout à fait normal ?

merci de me renseigner
Maguy

Patrice33740 · Answer

Bonjour Maguy,

Cela ne vient pas du code, je viens de vérifier, ce code occupe à peine plus de 3 ko supplémentaires

Je te propose de repartir sur un fichier propre :
- ouvre un nouveau fichier
- copie les informations et formules de ton fichier (seulement la zone utilisée) sur la nouvelle feuille.
- copie aussi le code
- enregistre ce fichier

Sinon peux-tu mettre une copie sur http://cijoint.fr/

Cordialement
Patrice

Patrice33740 · Answer

Re,

Je pense que tu as mal compris, dans mon poste du  7 sep 2010 à 14:37
je t'ai dis que copie et rng doivent être des cellules uniques (pas A6:A40 mais A6, pas B4:B38 mais B4)

Quand je parle d'« étendre des formules sur la totalité d'une colonne au lieu de limiter au strict nécessaire » c'est sur la feuille de calcul, pas dans la macro !

Comme je te l'ai dis précédemment : cela ne vient pas du code (de la macro)

Cordialement

Patrice33740 · Answer

Bonsoir maguy,

J'essayais de répondre à «je suis passée de quelques centaines d'octets à plus de 5Mo.»

Le fichier que tu mets en exemple ne reflète en rien le problème, il fait à peine 43 ko (macro comprise).

J'ai donc mis 2500 noms et les prénoms correspondants (les personnes ont en général 2 à 3 prénoms) sur la feuille «données». 

J'ai effacé les données de la feuille «copie» et j'ai enregistré le fichier : il fait 219 ko
Après avoir exécuté la macro et enregistré le fichier : la taille passe à 318 ko

Cela me semble cohérent puisque cette macro dédouble les informations de la feuille «données» vers la feuille «copie».

Je ne comprends pas pourquoi ton fichier passe de quelques dix millièmes de Mo à 5 Mo. Sa taille serait multipliée par 50 000 !!!.
Il est possible que lors des essais de mise au point de la macro tu aies multiplié la taille du fichier en copiant des données un peu partout.

Fait comme moi : repart à zéro à partir de ton fichier exemple.

Cordialement
Patrice

Macro copier ds 1 cellule 2 données séparées

16 réponses

Newsletters