Sur un même classeur, copier coller des données d'une feuille sur une autre (format)

[DjouPernet]

Bonjour à tous,

Je suis actuellement en stage. Mon projet est de concevoir des gammes de maintenances à l'aide d'un logiciel propre à l'entreprise et excel 2010.

Cependant j'ai des connaissances restreintes en terme de VBA et je connais un soucis et malgré un certain nombre de tests je n'arrives pas à y remédier.

J'ai une feuille qui, en indiquant une donnée sur ça première page, va récupérer le contenu d'une autre feuille pour les pages suivantes (même classeur). Ceci se fait via un copier coller.

Le problème qui persiste, j'aimerais garder une mise en page semblable entre le copier et le coller.

J'arrives à récupérer tout les composants ( certaines images, tableau...) mais il y a des décalages dû à des hauteurs de lignes qui diffèrent entre le copier et le coller.

COMMENT REMEDIER A CE PROBLEME ??

J’espère que vous avez compris mon soucis, voilà ce que j'ai réalisé :


If Sheets("Gamme").Cells(6, 4).Value = "CITARO ARTICULE" Then

Rows("39:300").EntireRow.AutoFit 'largeur des lignes adaptée au contenu

Sheets("Gamme CITARO ARTICULE").Activate


Sheets("Gamme CITARO ARTICULE").Range("A36:H300").Select

Selection.Copy

Sheets("Gamme").Select

Range("A39").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ActiveSheet.Paste

Else 'sinon je retire le texte et les images
Sheets("Gamme").Range(Cells(39, 1), Cells(500, 20)) = ""

For Each s In ActiveSheet.Shapes

If Not Intersect(s.TopLeftCell, Range("$A$39:$H$300")) Is Nothing Then
s.Delete
End If
Next s
End If


End If


End Sub

 

[JJ1]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

Bonjour,

je ne suis pas sûr mais il me semble que paste format n'est valable que sur des cellules, il faut copier les lignes entières.

A+

 

[DjouPernet]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

Okay merci bien pour l'information !

Par contre, vous savez ce qu'il faut introduire dans le programme pour garder un même format au niveau des lignes ?

 

[DjouPernet]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

En fait, pour résumé mon problème assez simplement :
- J'ai 2 hauteurs de lignes différentes dans ma feuille que je viens copié (0.56 et 0.93)
- Dans ce qui se colle, une seule hauteur : 0.56

==> J'ai donc une seule hauteur de ligne qui se colle et non l'autre, j'aimerais avoir une solution pour réussir à garder ces 2 hauteurs.

Merci d'avance !

 

[JJ1]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

Re,

J'ai lu un code d'Efgé pour égaliser les hauteurs de ligne, du genre:
For i = 1 To 10
Sheets("Feuil2").Rows(i).RowHeight = Sheets("Feuil1").Rows(i).RowHeight
Next i

a+

 

[DjouPernet]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

Bonjour,

Merci pour cette réponse qui fonctionne. Seulement je ne peux pas me permettre d'utiliser cette solution car pour un élément ça irait, mais j'aurais par la suite une dizaine de feuille à utiliser et je vois mal à chaque fois dire : de telle ligne à telle ligne j'ai une hauteur de tant , etc...

J'aimerais alors savoir si il existe une formule qui dit : lors de mes copier coller, la hauteur des lignes du copier sera identique dans mon collé.

Merci d'avance ! bonne journée

 

[Efgé]

Re : Sur un même classeur, copier coller des données d'une feuille sur une autre (for

Bonjour DjouPernet, JJ1

Sans exemple, et avec juste une bribe de code, difficile de comprendre le déroulé.

Pour conserver directement les hauteurs de lignes, il faut les insérer et non les coller.
Ensuite il faut réappliquer les largeur de colonnes et, si nécessaire, écraser les formules (xlPasteValues)

Ma proposition:

Sub test()
Dim S As Shape
With Sheets("Gamme")
    If .Cells(6, 4).Value = "CITARO ARTICULE" Then
        .Rows("39:300").EntireRow.AutoFit
        Sheets("Gamme CITARO ARTICULE").Rows("36:300").Copy
        With .Range("A39")
            .Insert
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With
    Else
        .Range(.Cells(39, 1), .Cells(500, 20)).ClearContents 'mieux que = ""
        For Each S In .Shapes
            If Not Intersect(S.TopLeftCell, .Range("$A$39:$H$300")) Is Nothing Then S.Delete
        Next S
    End If
End With
End Sub

Cordialement