Copier plusieurs cellules en une seule cellule

Bonjour les amis(es)!

j'ai réalisé le code suivant qui ne fonctionne pas vraiment.

Sub ConsolidationTimeSheet_Open()

Dim i As Integer

For i = 5 To Range("G6350").End(xlUp).Row

Workbooks("time sheet_semaine.xlsx").Worksheets("janvier").Range("G" & i).Copy

Workbooks("Time Sheet Mensuel.xls").Worksheets("Direction Développement").Range("G" & i + 4).Select

ActiveSheet.Paste

ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate

Workbooks("time sheet_semaine.xlsx").Worksheets("janvier").Range("H" & i).Copy

Workbooks("Time Sheet Mensuel.xls").Worksheets("Direction Développement").Range("G" & i + 4).Select

ActiveSheet.Paste

ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate

Workbooks("time sheet_semaine.xlsx").Worksheets("janvier").Range("I" & i).Copy

Workbooks("Time Sheet Mensuel.xls").Worksheets("Direction Développement").Range("G" & i + 4).Select

ActiveSheet.Paste

ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate

Workbooks("time sheet_semaine.xlsx").Worksheets("janvier").Range("J" & i).Copy

Workbooks("Time Sheet Mensuel.xls").Worksheets("Direction Développement").Range("G" & i + 4).Select

ActiveSheet.Paste

ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate

Next i

End Sub

Objectif du travail: copier le contenu des cellules pour chaque semeine dans un fichier mensuel dans lequel chaque cellule va contenir le contenu de quatres cellules dans le fichier précédent.

Ci-joint mes fichiers utilisées.

Merci d'avance.

Bonjour,

je vais voir ton souci mais première régle avec les codes VBA, ne JAMAIS utiliser de cellules fusionnées (on le dit souvent...). Ton fichier Time sheets mensuelle ne contient que cela.

Si pas de souci, je modifie ton fichier

A quel moment copies-tu les infos et es-tu suceptible de devoir recopier ou ajouter des infos

Amicalement

Bonjour DAN,

Je dois consolider chaque fin du mois, d'habord pour février, ensuite mars, etc.

J'ai utilisé des cellules fusionnées parceque le texte consolidé (les quatres semaines) est long et ne peut pas être contenu dans une cellule simple. Si on ne peut pas joindre macro et cellules fusionnées, est ce qu'il ya une solution pour ça. Merci d'avance.

Respectueuses Salutations,

Re,

J'ai utilisé des cellules fusionnées parceque le texte consolidé (les quatres semaines) est long et ne peut pas être contenu dans une cellule simple

Je ne vois pas le souci dans le fichier, il suffit d'augmenter la hauteur de la ligne non ?

A te relire

Bonjour,

Même avec ça la hauteur est limitée et ne suffit pas.

Sinon j'annule fusionner les cellules. et je fais ce qui suit

1ère et 2ième semaine seront copiées dans une cellule

3ème semaine copiée dans la cellule au-dessous

4ème semaine copièe dans la troisième cellule au-dessous

Salutations,

Re,

Ok pour ta dernière suggestion.

Le fichier Time sheet mensuel est déjà prérempli ou on peut prendre toutes les données depuis le fichier de base ??

De base je suppose que ce fichier est vide de données.

Merci de confirmer

salut,

oui, toutes les données à partir du fichier de base.

a+

Re,

De base si on attribue tes données semaine des colonnes G, H, I, J sur une ligne / semaine c'est bon ?

En gros cela donnerait un nom toutes les 4 lignes (exemple G9, G10, G11, G12).

A te relire

Bonjour,

oui, d'accord.

Merci de m'aider à modifier mon code.

Salutations,

Re,

Voici le code que tu peux utiliser moyennant les changements suivants :

• Renommer le fichier "Time sheet mensuel" comme ceci --> Time_Sheet_Mensuel
• Renommer la feuille come suit --> "Direction_Developpement"
• Renommer le fichier "time sheet semaine" en --> time_sheet_semaine

Le code à utiliser en lieu et place du tien :

Sub ConsolidationTimeSheet()
'Macro modifié par Dan - 11/03/13
Dim i As Integer, lg As Integer
Dim wbk1 As Workbook
Dim wbk2

Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks("Time_Sheet_Mensuel.xls").Sheets("Direction_Developpement")
lg = wbk2.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wbk2.Rows(9 & ":" & lg).Clear
wbk2.Range("G1") = wbk1.ActiveSheet.Name
lg = 9
For i = 5 To Range("B" & Rows.Count).End(xlUp).Row
With wbk2

    wbk1.ActiveSheet.Range("A" & i & ":G" & i).Copy .Range("A" & lg)
    wbk1.ActiveSheet.Range("H" & i).Copy .Range("G" & lg + 1)
    wbk1.ActiveSheet.Range("I" & i).Copy .Range("G" & lg + 2)
    wbk1.ActiveSheet.Range("J" & i).Copy .Range("G" & lg + 3)

End With
wbk2.Range("A" & lg & ":G" & lg + 3).BorderAround ColorIndex:=0, Weight:=xlThick
With wbk2.Range("A" & lg & ":F" & lg + 3).Borders(xlInsideVertical)
    .ColorIndex = xlAutomatic
    .Weight = xlThin
End With
wbk2.Range("A" & lg & ":F" & lg + 3).Borders(xlInsideHorizontal).LineStyle = xlNone
lg = lg + 4

Next i

End Sub

De base j'ai considéré que les deux fichiers sont ouverts.

Une fois positionné sur ton fichier "time sheet semaine", exécute le code que je t'ai donné

Si ok, lors de ta réponse clique sur le V vert à coté du bouton EDITER afin de cloturer le fil.

Amicalement

Bonjour DAN,

Je vous remercie pour le code, mais au niveau de la ligne suivante (lg = wbk2.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1) la réponse est erreur: l'indice n'appartient pas à la selection.

j'ai fait tout ce que vous avez dit.

au niveau de Dim wbk2, j'ai rajouté as workbook.

est ce que je peux poster mes fichiers modifiés dans ce forum pour que vous puissiez voir cette erreur. Merci.

Salutations,

Re,

Ben non justement tu ne dois pas rajouter workbook au niveau Dim wbk2

Vérifie aussi que le nom de tes fichiers et feuilles sont bien ceux trouvés dans le code

A te relire

Bonjour,

Oui, j'ai vérifié les modifications.

Exemple: la première ligne à copier est G5 H5 I5 J5 du fichier/semaine à G9 G10 G11 G12 fichier/mois

le blocage du code se situe toujours sur la même ligne lg

Slts,

j'ai refais l'exécution et ça marche très bien.

Milles Merci.

Respectueuses Salutations.