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

[nat54]

[RESOLU] Copie d'une cellule lors d'un chgt de valeur

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 ""

Sub Creer_Base_Accroi()

Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire
Application.DisplayAlerts = False

For lgn = 29 To 29   'pour boucler sur les lignes

Sheets("Ref").Select   'on se place sur la feuille de référence
regate = Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1


Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls")
Sheets("CDD accroi").Select
Range("A9:G200").Select
Selection.Copy

Windows("CDD_test.xls").Activate
Sheets("Base_Accroi").Select
  If [a3] = "" Then Range("b3").Activate Else Selection.End(xlDown).Select
    ActiveCell.Activate
    ActiveCell.Offset(1, 0).Activate
      ActiveSheet.Paste
   Range("a1").Select
   
   '' Windows(regate & ".xls").Activate
   '' Range("a2").Select
   '' Selection.Copy
   '' Windows("CDD_test.xls").Activate
   '' ActiveCell.Activate
   ''   ActiveCell.Offset(0, -1).Activate

   
     ActiveSheet.Paste
   
   
     Range(" a1 ").Select

Workbooks(regate & ".xls").Close  'fermer le fichier

Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)

Application.ScreenUpdating = True

End Sub

 

[nat54]

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

Solution (on m'a aidé !!)

Sub Creer_Base_Accroi()

Dim regate$, iRC%

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For lgn = 29 To 30
regate = Sheets("Ref").Cells(lgn, 1)
'Détection de la première ligne libre
iRC = Workbooks("CDD_test.xls").Worksheets("Base_Accroi").Range("B65536").End(xlUp).Row + 1

Workbooks.Open ("U:\PUBLIC\DOTC\DFI\CGC\Commun\Remontee Outil FTV3\07_2006\" & regate & ".xls")

With Workbooks(regate & ".xls").Worksheets("CDD accroi")

  'Copie Range("A2") en colonne A sur la première ligne libre de la cible (iRC)
  Workbooks("CDD_test.xls").Worksheets("Base_Accroi").Range("A" & iRC) = .Range("A2")
  
  'Copie la zone ("A9:G200") en colonne A sur la première ligne libre
  .Range("A9:G200").Copy Workbooks("CDD_test.xls").Worksheets("Base_Accroi").Range("B" & iRC)

End With

Workbooks(regate & ".xls").Close  'fermer le fichier

Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
Application.ScreenUpdating = True
End Sub

Je repose ma question
Maintenant j'ai bien

- entité 1 nom 1
- "" nom 2
- "" nom 3
- entité 2 nom 1
- "" nom 2
- "" nom 3

est-ce possible d'étirer AUTOMATIQUEMENT le nom del'entité où il n'y a "" ?

MERCI

 

[nat54]

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

Il me faudrait un truc du genre mais c'est à travailler...

Sub Etirer_Regate()

For i = 3 To 5000

Sub Etirer_Regate()

For i = 3 To 5000


If ("A" & i-1).Value <> "" AND ("A" & i+1).Value <> ("A' & i-1).Value Then ["A" & i]= ("A" & i-1).Value




    
    
End Sub

  
   
End Sub

 

[nat54]

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

Nobody ?
c'est la dernière étape de mon fichier...

 

[nat54]

[RESOLU] Copie d'une cellule lors d'un chgt de valeur

J'ai eu la solution ailleurs

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

 

[nat54]

Re : [RESOLU] Copie d'une cellule lors d'un chgt de valeur

Comment on fait pour mettre notre topic [RESOLU] ?