Ajouter un critère

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention -
Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention - 25 avril 2016 à 12:26

Bonjour,
voila mon code macro, il consiste a nettoyer une feuille excel il déplace quelques colonnes et elle delete les autres, j'aimerai avant de supprimer les autres colonnes de déplacer les colonnes : M vers K et P vers J:

<code xml>Sub NETTOYAGE()
If MsgBox("Etes-vous sur de vouloir nettoyer le journal?", vbOKCancel) = vbCancel Then
    End
End If
   

    Range( _
        "A:B,I:M,P:AH" _
        ).Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Cut Destination:=Columns("C:C")
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Columns("F:F").ColumnWidth = 4.29
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Selection.Cut Destination:=Columns("A:A")
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("H:H").Select
    Selection.Cut Destination:=Columns("B:B")
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("L:L").Select
    Selection.Cut Destination:=Columns("E:E")
    Columns("J:J").Delete Shift:=xlToLeft
    
    'pour déterminer le nombre de lignes
    Dim nbCells As Long
    nbCells = Application.WorksheetFunction.CountA(Columns("F:F"))
    
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
    Range("I2").Select
    Selection.Copy
    Range("I2").Select
    Application.CutCopyMode = False
    If nbCells > 0 Then
        Selection.AutoFill Destination:=Range("I2:I" & nbCells), Type:=xlFillDefault
    End If
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

    Columns("A:A").Select
    
    CorrectionDateScanfact
    
End Sub

</code>

Afficher la suite

A voir également:

Ajouter un critère
Ajouter un profil netflix payant - Accueil - Guide streaming
Impossible d'ajouter un ami sur facebook - Guide
Ajouter un compte whatsapp - Guide
Ajouter un compte facebook - Guide
Ajouter signature word - Guide

2 réponses

Réponse 1 / 2

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Up Merci

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Plz up

Réponse 2 / 2

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

Bonjour
j'aimerai avant de supprimer les autres colonnes de déplacer les colonnes : M vers K et P vers J A partir de quelle ligne?
Servez vous de l'enregistreur de macro comme vous l'avez fait pour supprimer les colonnes.
Profitez en pour arranger le résultat obtenu; exemple: voici le même début de votre macro après toilettage

    Columns("C:C").Insert Shift:=xlToRight
    Columns("E:E").Cut Destination:=Columns("C:C")
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("F:F").ColumnWidth = 4.29
    Columns("A:A").Insert Shift:=xlToRight
    Columns("F:F").Cut Destination:=Columns("A:A")
    Columns("B:B").Insert Shift:=xlToRight
    Columns("H:H").Cut Destination:=Columns("B:B")
    Columns("C:C").Insert Shift:=xlToRight
    Columns("E:E").Insert Shift:=xlToRight
    Columns("L:L").Cut Destination:=Columns("E:E")
    Columns("J:J").Delete Shift:=xlToLeft

Cdlt

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

je n'ai pas compris comment je peux introduire cette macro a mon macro origine??

nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Mr Frenchie83, merci de m'aider sur ça !

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338 > nonossov Messages postés 610 Date d'inscription Statut Membre Dernière intervention

Bonjour
Il ne s'agit pas d'introduire, mais de remplacer
Votre code légèrement modifié:

Sub NETTOYAGE()
    Application.ScreenUpdating = False
    Dim nbCells As Long
    If MsgBox("Etes-vous sur de vouloir nettoyer le journal?", vbOKCancel) = vbCancel Then End
    Range("A:B,I:M,P:AH").Delete
    Columns("C:C").Insert
    Columns("E:E").Cut Destination:=Columns("C:C")
    Columns("E:E").Delete
    Columns("F:F").ColumnWidth = 4.29
    Columns("A:A").Insert
    Columns("F:F").Cut Destination:=Columns("A:A")
    Columns("B:B").Insert
    Columns("H:H").Cut Destination:=Columns("B:B")
    Columns("C:C").Insert
    Columns("E:E").Insert
    Columns("L:L").Cut Destination:=Columns("E:E")
    Columns("J:J").Delete
    
   'pour déterminer le nombre de lignes
    nbCells = Application.WorksheetFunction.CountA(Columns("F:F"))
    Range("I2:I" & nbCells).FormulaR1C1 = "=RC[-2]+RC[-1]"
    Rows("1:1").Delete
    Columns("A:A").Select
    CorrectionDateScanfact
End Sub

Quant à votre demande: j'aimerai avant de supprimer les autres colonnes de déplacer les colonnes : M vers K et P vers J A partir de quelle ligne?
Comme je l'ai dit plus haut, servez vous de l'enregistreur de macro comme vous l'avez fait pour supprimer les colonnes et retouchez (si vous le voulez, mais ce n'est pas obligatoire) le code obtenu pour clarifier l'écriture et ainsi faciliter la lecture.
Cdlt

Discussions similaires

ordre alphabetique sous word

Comment savoir comment on nous a ajouté sur Snap

Je n'arrive pas à ajouter un ami sur Facebook

Votre réponse

Discussions similaires