Copier/coller colonne

Bonjour,

C'est un problème certainement simple pour les experts d'Excel mais pas facile pour moi

Sub Traitement()

Dim td As Sheets
Dim taille As Range
Dim myDate As Date
Dim derligne As Long

      With Sheets("traitement date")
        Set taille = .Range("A2:DX761")
         For Each cell In taille
          If InStr(1, cell.Text, "%") > 0 Then
           cell.EntireColumn.Rows("2:761").Select
           Selection.Copy
           Selection.Paste after column.select

            End If
            Next
            End With

End Sub

Voici une partie de mon code. Mon but est que si je rencontre une cellule au format pourcentage, je la sélectionne entièrement, je la copie et je la colle juste après celle-ci mais c'est la ou sa coince pour moi

Je vous remercie

Julien

Salut Jujudeo,

bon, j'ai essayé de traduire ce que tu voulais!

Quand tu rencontres une cellule au format %, tu veux copier la colonne correspondante en l'insérant directement à sa droite?

C'est fait comme ça dans le fichier joint! Pour le reste...

A+

bonjour curulis57,

après pas mal d'heure passer dessus, j'ai enfin réussi a réaliser se que je désirais ! voici ma macro qui marche nikel :

Sub Traitement()

Dim td As Worksheet
Dim myDate As Date
Dim derligne As Long
Dim x As Range 'cellule affichant le coefficient multiplicateur 100
Dim taille As Range '1ère ligne contenant le symbole % dans les en-tête
Dim colonne As Integer 'n° de la colonne à modifier
Dim lignefin As Integer 'n° de la dernière ligne

On Error Resume Next 'si la feuille n'existe pas !
Application.DisplayAlerts = False: Sheets("traitement date").Delete: Application.DisplayAlerts = True
On Error GoTo 0 'plus de gestionnaire d'erreurs
Worksheets("PO - PB").Copy After:=Worksheets("base donnee") 'création de la feuille
ActiveSheet.Name = "traitement date" 'nom de la feuille'
Sheets("base donnee").Range("A1:DX1").Copy Sheets("traitement date").Range("A1:DX1")
ActiveSheet.AutoFilterMode = False 'desactiver les filtres'
ActiveWindow.FreezePanes = False 'désactiver les volets'
ligne = Range("A" & Rows.Count).End(xlUp).Row
colomne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
With Sheets("traitement date")

       Set x = Range("A" & ligne + 10)
         x.Value = 100
      With Sheets("traitement date")
        Set taille = .Range("A2:DX100")
     For Each cell In taille
           If InStr(1, cell.Text, "%") > 0 Then
             colonne = cell.Column
             lignefin = cell.End(xlDown).Row
             x.Copy
             Range(Cells(1, colonne), Cells(lignefin, colonne)).PasteSpecial _
             Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:=True
                 For i = 2 To lignefin
                 If CStr(Cells(i, colonne)) = "Erreur 2015" Then Cells(i, colonne) = ""
                 Next i
             Selection.NumberFormat = "0.00"
             Selection.Copy
            'Selection.Offset(0, 0).Select
            'Selection.EntireColumn.Insert
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            'Selection.Offset(0, 0).Delete
           End If
           Next
    End With
    'on efface la valeur 100 en bas du tableau (utilisée pour le collage spécial)
    Range("A" & ligne + 10).Clear

 For Each cel In Range("A2:DX100")
     cel.Value = Replace(cel.Value, "", "")
 Next

End Sub

la deuxième partie est tout le processus qui marche très bien !! Après, je me doute qu'il y a sans doute moyen de l'optimiser encore plus....

Merci de vos conseils