Copié/Collé

[gab]

Bonjour,

J'ai besoin d'une aide pour la réalisation de deux petites macros.

Les deux difficultés que je rencontre :

Première macro :
Faire un "copié" de plusieurs cellules non conjointes.

Seconde macro :
Faire un "collé" des valeurs dans un ordre précis.

Tout est expliqué dans le fichier joint


Merci de votre aide.

 

[Papy Novice]

Salut Gab
Est-ce que ceci te convient ? A regarder et modifier éventuellement selon tes besoins.
Amicalement à toi
Jean

 

[Denis Jette]

Salut Gab
Est-ce que ceci te convient ?

Sub copy_transpose()
'add sheet2
Sheets("Sheet1").Select
Range("C1:C" & Range("C65536").End(xlUp).Row).Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Range("A1").Select
Call Delete_Column
End Sub
Sub Delete_Column()
Dim lnColumns As Long, i As Long, j As Long
Dim rnArea As Range
Application.ScreenUpdating = False



lnColumns = ActiveSheet.Columns.Count

For i = lnColumns To 1 Step -1
If Application.CountA(Columns(i)) = 0 Then
Columns(i).Delete
j = j + 1
End If
Next i

Columns.Resize(, lnColumns - j).Select

Application.ScreenUpdating = False
Call reformat
End Sub
Sub reformat()
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Interior.ColorIndex = xlNone
End Sub