Copie d'une cellule lors d'un chgt de valeur

Copie d'une cellule lors d'un chgt de valeur - VB/VBA/VBS - Programmation

Marsh Posté le 03-08-2006 à 14:47:21    

Bonjour,
 
Je ne trouvais pas de titre explicite, désolée
 
Mon problème
--> j'ai 64 fichiers (un par entité) dans lesquels un onglet "cdd accroi" (= cdd pour accroissement d'activité) m'intéresse  
j'arrive donc à ouvrir le fichier, copier la plage qui m'intéresse et la coller dans...
 
--> ... un fichier récapitulatif des 64 entités
 
Cependant ce que je voudrais c'est le N° de l'entité dans la colonne A à chaque chgt d'entité
Ce n° est présent en cellule A2 sur chacun des 64 fichiers
 
Comment le récupérer et le mettre à chaque chgt d'entité ?
 
MERCI
 
mon code actuel et l'erreur est entre ""
 

Code :
  1. Sub Creer_Base_Accroi()
  3. Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire
  4. Application.DisplayAlerts = False
  6. For lgn = 29 To 29   'pour boucler sur les lignes
  8. Sheets("Ref" ).Select   'on se place sur la feuille de référence
  9. regate = Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1
  12. Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls" )
  13. Sheets("CDD accroi" ).Select
  14. Range("A9:G200" ).Select
  15. Selection.Copy
  17. Windows("CDD_test.xls" ).Activate
  18. Sheets("Base_Accroi" ).Select
  19.   If [a3] = "" Then Range("b3" ).Activate Else Selection.End(xlDown).Select
  20.     ActiveCell.Activate
  21.     ActiveCell.Offset(1, 0).Activate
  22.       ActiveSheet.Paste
  23.    Range("a1" ).Select
  24.  
  25.    '' Windows(regate & ".xls" ).Activate
  26.    '' Range("a2" ).Select
  27.    '' Selection.Copy
  28.    '' Windows("CDD_test.xls" ).Activate
  29.    '' ActiveCell.Activate
  30.    ''   ActiveCell.Offset(0, -1).Activate
  32.  
  33.      ActiveSheet.Paste
  34.  
  35.  
  36.      Range(" a1 " ).Select
  38. Workbooks(regate & ".xls" ).Close  'fermer le fichier
  40. Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
  42. Application.ScreenUpdating = True
  44. End Sub

Reply

Marsh Posté le 03-08-2006 à 14:47:21   

Reply

Marsh Posté le 04-08-2006 à 09:06:32    

J'ai un peu avancé mais ce n'est pas encore ca...
 
J'ai toujours un souci : je mets des screenshot, ca aidera peut-être...
(retravailler les fichiers me prendrait trop de temps étant donné nb d'onglets..)
 
Le fichier-source est le suivant (enfin y'en a 64 comme ca )
http://pix.nofrag.com/b4/35/4a15e6ba410a3399c1a77ab07e82.jpg
 
Le fichier destination se présente comme suit :
http://pix.nofrag.com/e5/0c/8668ef70cf3b95fbb1cd20f4c2a9.jpg
 
 
Donc la 1ère boucle marche correctement comme vous le voyez...
 
Mais les suivantes ne marchent pas ; là j'ai bouclé sur 2 entités :  
 
- pb 1 : décalage de colonne où l'on retrouve les données
 
- pb 2 : il m'a mangé une ligne de la 1ère entité...
 
- pb 3 : le n° entité dans le fichier source est une formule ..  
donc le 1er marche bien,  
='U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\[671650.xls]Notice'!H4&" "&'U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\[671650.xls]Notice'!I4
 
 
mais ensuite le 2nd se décale
http://pix.nofrag.com/3b/46/dd136b1ff979caf5738d065f1e56.jpg
='U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\[671920.xls]Notice'!H10&" "&'U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\[671920.xls]Notice'!I10
 
pour pallier à cela, il faudrait juste un copier-coller , collage spécial, valeur
mais ca se dit comment en VB ?
 
MERCI
 
 
 
Le code actuel

Code :
  1. Sub Creer_Base_Accroi()
  3. Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire
  4. Application.DisplayAlerts = False
  7. Dim maplage As Range
  10. For lgn = 29 To 30   'pour boucler sur les lignes
  12. Sheets("Ref" ).Select   'on se place sur la feuille de référence
  13. regate = Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1
  16. Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls" )
  17. Sheets("CDD accroi" ).Select
  18. Range("A9:G200" ).Select
  19. Selection.Copy
  21. Windows("CDD_test.xls" ).Activate
  22. Sheets("Base_Accroi" ).Select
  23.   If [a2] = "" Then Range("b1" ).Activate Else Selection.End(xlDown).Select
  24.     ActiveCell.Activate
  25.     ActiveCell.Offset(1, 0).Activate
  26.       ActiveSheet.Paste
  27.    Range("a1" ).Select
  28.  
  29.  
  31. Workbooks(regate & ".xls" ).Activate
  33. If Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("a2" ).Value = "" Then
  34. Set maplage = Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("a2" )
  35. Else
  36. Set maplage = Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("a2" ).End(xlDown).Offset(1, 0)
  37. End If
  39. Range("A2" ).Copy Destination:=maplage
  40.  
  43. Workbooks(regate & ".xls" ).Close  'fermer le fichier
  45. Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
  47. Application.ScreenUpdating = True
  49. End Sub

Reply

Marsh Posté le 04-08-2006 à 11:40:37    

On s'approche, on s'approche...
 
http://pix.nofrag.com/42/d8/b20aaf2e29ead1328e7d46f0487c.jpg
 
 
le code actuel

Code :
  1. Sub Creer_Base_Accroi()
  3. Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire
  4. Application.DisplayAlerts = False
  7. Dim maplage As Range
  10. For lgn = 29 To 30   'pour boucler sur les lignes
  12. Sheets("Ref" ).Select   'on se place sur la feuille de référence
  13. regate = Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1
  16. Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls" )
  17. Sheets("CDD accroi" ).Select
  18. Range("A9:G200" ).Select
  19. Selection.Copy
  21. Windows("CDD_test.xls" ).Activate
  22. Sheets("Base_Accroi" ).Select
  23. Range("b1" ).Activate
  24.   If [b2] = "" Then Range("b1" ).Activate Else Selection.End(xlDown).Select
  25.     ActiveCell.Activate
  26.     ActiveCell.Offset(1, 0).Activate
  27.       ActiveSheet.Paste
  28.    Range("a1" ).Select
  29.  
  30.  
  31.  
  32. Workbooks(regate & ".xls" ).Worksheets("CDD accroi" ).Range("A2" ).Copy
  33. Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("A65536" ).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
  38. Workbooks(regate & ".xls" ).Close  'fermer le fichier
  40. Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
  42. Application.ScreenUpdating = True
  44. End Sub


 
Le hic vient du xlUp lors de la copie du n° entité
car en fait là avec ce code c'est logique qu'il copie sous le 1er n° de l'entité
moi je voudrais qu'il copie en face de KOSIk, qui est le 1er nom de l'entité Holtzheim
 
Et je bloque..
MERCI
 
 
 
NOBODY POUR M'AIDER ?!?!

Reply

Marsh Posté le 04-08-2006 à 11:44:51    


tes lignes de code :  
Workbooks(regate & ".xls" ).Worksheets("CDD accroi" ).Range("A2" ).Copy
Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("A65536" ).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
 
ca récupere ce qu'il y a dans la cellule A2 de CDD et ca le copie en dernière ligne de la colonne A dans Base.
 
Et toi tu cherches à le mettre où exactement ? qu'est-ce que Kosik?

Reply

Marsh Posté le 04-08-2006 à 16:10:07    

je veux mettre le n° de l'entité en face du 1er nom de personne (ex : kosik) collé
- pour avoir la liste des personnes par entité -

Reply

Marsh Posté le 04-08-2006 à 20:56:20    

tu peux me préciser dans quel classeur se trouve la Sheets("Ref" )
Est-ce Workbooks("CDD_test.xls" ) ?

Reply

Marsh Posté le 04-08-2006 à 20:57:31    

Oui l'onglet "ref" est dans CDD_test
avec en colonne 1, tous les n° entités, pour réaliser la boucle

Reply

Marsh Posté le 04-08-2006 à 21:19:57    

Dernière question :
pourquoi  "A9:G200"
Est-ce parce que tu ne sais pas détecter la zone qui t'intéresse alors tu ratisses large ?

Reply

Marsh Posté le 04-08-2006 à 21:27:39    

Bon on va faire comme ça sans attendre ta réponse...
Tu me testes ça svp :

Code :
  1. Sub Creer_Base_Accroi()
  2. Dim regate$, iRC%
  3. Application.ScreenUpdating = False
  4. Application.DisplayAlerts = False
  6. For lgn = 29 To 30
  7. regate = Sheets("Ref" ).Cells(lgn, 1)
  8. 'Détection de la première ligne libre
  9. iRC = Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("B65536" ).End(xlUp).Row + 1
  11. Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls" )
  12. With Workbooks(regate & ".xls" ).Worksheets("CDD accroi" )
  13.   'Copie Range("A2" ) en colonne A sur la première ligne libre de la cible (iRC)
  14.   Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("A" & iRC) = .Range("A2" )
  15.   'Copie la zone ("A9:G200" ) en colonne A sur la première ligne libre
  16.   .Range("A9:G200" ).Copy Workbooks("CDD_test.xls" ).Worksheets("Base_Accroi" ).Range("B" & iRC)
  17. End With
  19. Workbooks(regate & ".xls" ).Close  'fermer le fichier
  21. Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
  22. Application.ScreenUpdating = True
  23. End Sub


Nota : Dans ce forum on ne peut pas récupérer les lignes de codes facilement par Copier / Coller
Pour le récupérer facilement par Copier / Coller, il faut que tu fasses comme si tu voulais modifier ma réponse  
(en cliquant sur le deuxième icone "crayon" )
http://perso.orange.fr/galopin01/images/modif.jpg
 
Si j'mé pas trompé ça devrait être bon...
A+


Message édité par galopin01 le 04-08-2006 à 22:25:24
Reply

Marsh Posté le 04-08-2006 à 21:53:33    

Yavait au minimum une 'tite erreur sans gravité dans les déclarations :
 
Dim regate$, iRC%

Reply

Marsh Posté le 04-08-2006 à 21:53:33   

Reply

Marsh Posté le 04-08-2006 à 22:28:56    

L'pauvre : l'en reste sans voix.
C'est l'émotion qui la terrassé !
 :D  
A moins que ce soit le marchand de sable...
Allez bonne nuit !
A+

Reply

Marsh Posté le 05-08-2006 à 09:20:44    

Oui c'était plutôt Koh Lanta qui m'a fait m'absenter :d
 
Je testerai ca lundi, car c'est pour le travail :)
Sinon pour les déclarations de variable, j'en fais jamais  :ouch:  
 
Merci
 
et pour répondre à ta question

Citation :

pourquoi  "A9:G200"
Est-ce parce que tu ne sais pas détecter la zone qui t'intéresse alors tu ratisses large ?


Je ne sais pas détecter car la plage est variable  :(

Reply

Marsh Posté le 05-08-2006 à 09:23:11    

J'ai plusieurs questions pour comprendre  
 
- à quoi sert le "xwith.. end with" ?
 
- ligne 14 : pourquoi il y a un point avant range ?
 
Merci

Reply

Marsh Posté le 05-08-2006 à 15:50:58    

cela rend le code plus lisible ,accélère l'exécution des procédures et permet d'éviter des saisies répétitives, quand il est complexe et avec beaucoup d'imbrications , ici il t'évite de répéter dans l'exemple de Galopin
Workbooks(regate & ".xls" ).Worksheets("CDD accroi" )
devant le .Range
 
Voir Aide en ligne


Message édité par kiki29 le 05-08-2006 à 15:52:01
Reply

Marsh Posté le 05-08-2006 à 21:31:13    

bonsoir et merci kiki29,
Merci, c'est exactement celà.
Nota : il ya a aussi un point au début de la ligne 16, ce qui évite également la répétition devant le .Range
A+


Message édité par galopin01 le 05-08-2006 à 21:33:40
Reply

Marsh Posté le 07-08-2006 à 10:48:49    

Je viens de tester et ca marche nickel :)
 
Maintenant je vais juste chercher (je sais pô si c'est possible)
d'étirer automatiquement les n° entités face aux personnes les concernant
car le N° n'est présent que face à la première personne de l'entité

Reply

Marsh Posté le 07-08-2006 à 11:11:41    

J'essaie avec ca mais c'est à travailler
 

Code :
  1. Sub Etirer_Regate()
  3. For i = 3 To 5000
  5. If ("A &i-1" ).Value <> "" AND ("A &i+1" ).Value <> ("A &i-1" ).Value
  6. Then ["A &i"]= ("A &i-1" ).Value
  8.  
  9. End Sub

Reply

Marsh Posté le 07-08-2006 à 14:29:42    

Bonjour,
 
Sub Etirer_Regate()
i = 1
Do While Cells(i, 2) <> ""
If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
i = i + 1
Loop
End Sub
 
A+

Reply

Marsh Posté le 07-08-2006 à 15:48:00    

la macro foctionne nickel  
 
j'aurai pu chercher longtemps avec mes value ;)

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed