modif de macro

[dede039]

bonjours le forum

j'ai besoin de votre aide j'ai se code qui marche bien mais quand ont l'exécute tout clignote
je voudrai que tout se face en "invisible"

Sub macro1()
    Sheets("Feuil2").Select
    Dim X As Range
        Set X = Range(Cells(1, 1), Cells(65535, 1)).Find("", , xlValues, xlWhole, , , False) 'recherche premiere ligne vide
        deb = 0
            If Not X Is Nothing Then
                deb = (X.Row) 'deb= num ligne vide
            End If
    Range("A1").Select
    Range(Cells(1, 1), Cells(deb - 1, 50)).Select ' nombre de colonne
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Set X = Range(Cells(1, 1), Cells(65535, 1)).Find("", , xlValues, xlWhole, , , False)
    i = X.Row
    Range("A1").Select
    ActiveCell.Offset(i - 1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Select
    Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
    i = 0
        Do Until ActiveCell.Offset(i, 0).Value = ""
            i = i + 1
            p = 0
            For j = 1 To 26 'nombres de colonne traite
                If ActiveCell.Offset(i, j).Value = ActiveCell.Offset(i - 1, j).Value Then
                    p = p + 1
                End If
                If p = 26 Then
                    Rows(i).Delete
                    i = i - 1
                End If
            Next j
        Loop
End Sub

 

[gege21]

Re : modif de macro

il y aura des donnes en feuille 1et 2
et la macro pourra etre lance des feuille 3.7et 11

 

[ROGER2327]

Re : modif de macro

Re…

Essayez ceci :

Sub macro1()
Dim deb&, i&, j%, p As Boolean, X As Range, sh As Worksheet
  Application.Calculation = -4135
  Set sh = Sheets("Feuil2") ' <--------------
  With Sheets("Feuil1")
    Set X = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1)).Find("", , xlValues, xlWhole, , , False)
    i = X.Row
    Set X = sh.Range(sh.Cells(1, 1), sh.Cells(sh.Rows.Count, 1)).Find("", , xlValues, xlWhole, , , False)
    If X Is Nothing Then deb = 0 Else deb = X.Row
    sh.Range(sh.Cells(1, 1), sh.Cells(deb - 1, 50)).Copy Destination:=.Range("A1").Offset(i - 1, 0)
    .Cells.Sort Key1:=.Range("C1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    i = 0
    Do Until .Cells(1, 1).Offset(i, 0).Value = ""
      i = i + 1
      p = True
      For j = 1 To 26
        p = p And (.Cells(1, 1).Offset(i, j).Value = .Cells(1, 1).Offset(i - 1, j).Value)
      Next j
      If p Then
        .Rows(i).Delete
        i = i - 1
      End If
    Loop
  End With
  Application.Calculation = -4105
End Sub

Si cela ne convient pas, déposez votre classeur (.xls) avec une description complète et précise des problèmes rencontrés.​

ROGER2327
#4806

Mardi 24 Sable 138 (Sainte Pochetée, gouvernante, SQ)
4 Nivôse An CCXIX
2010-W51-5T11:42:25Z

 

[gege21]

Re : modif de macro

je vais teste plus en profondeur mais cela a l'ère de bien marche
si quelque chose ne va pas je reviendrais (mais j'en doute)
merci pour votre aide