ce code est-il correct

[jad73]

bonjour le forum
j'ai une macro qui s'exécute a la suite mais seul le premier couplé est correct. La macro prend en BN2:BO2 les donnés est les inscrit en U1:V1, hors quand j'exécute le code pas a pas arrivé a la partie 'extraire' la plage de données est vide donc il semblerait que le deuxieme couplé n'a pas été inscrit en U1:V1. Le partie du code ou il y aurait l'erreur est celui-ci

'ajoute 2eme couplé col BN:BO a U1:V1
    Range("U1:V1").Value = Range("BN" & Ligne & ":BO" & Ligne).Value
    ActiveSheet.Calculate

voici le code en entier

Sub Macro_Atester()
Dim Ligne As Long, Indice As Long
'efface la BdD Y:AR
  Worksheets("Feuil1").Select
  For Ligne = 2 To Range("BN" & Rows.Count).End(xlUp).Row
    Range("Y2:AR3012").ClearContents
       
'ajoute 2eme couplé col BN:BO a U1:V1
    Range("U1:V1").Value = Range("BN" & Ligne & ":BO" & Ligne).Value
    ActiveSheet.Calculate
'extraire les lignes de A:T a Y2
    Dim I&, Fin&, aa, bb, y&, a&
    With Feuil1
      Fin = .Range("A" & Rows.Count).End(xlUp).Row
      aa = .Range("A2:W" & Fin)
    End With
    y = 1
    ReDim bb(UBound(aa, 2), y)
    For I = 1 To UBound(aa) - 1
      If aa(I + 1, 22) = 1 Then
        ReDim Preserve bb(UBound(aa, 2), y)
        For a = 1 To UBound(aa, 2) - 3
          bb(a, y) = aa(I, a)
        Next a
        y = y + 1
      End If
    Next I
   
    Range("Y2").Resize(UBound(bb, 2), UBound(bb)) = Application.Transpose(bb)

'Sub Combinaison()
  Dim D As Integer, K As Integer, L As Integer, M As Integer
  Dim NbMax As Integer
  Dim Tablo(1 To 70, 1 To 70, 1 To 70, 1 To 70) As Integer
  Dim J As Long
  Dim Resultat(1 To 1, 1 To 5)
  Dim Tbl1
  Dim Nombre As Integer
  
    Application.ScreenUpdating = False
    Tbl1 = Range("Feuil1!BdD")
    NbMax = UBound(Tbl1, 2)
    
    For J = 1 To UBound(Tbl1)
      For D = 1 To NbMax - 3
        For K = D + 1 To NbMax - 2
          For L = K + 1 To NbMax - 1
            For M = L + 1 To NbMax
            Tablo(Tbl1(J, D), Tbl1(J, K), Tbl1(J, L), Tbl1(J, M)) = Tablo(Tbl1(J, D), Tbl1(J, K), Tbl1(J, L), Tbl1(J, M)) + 1
            Next M
          Next L
        Next K
      Next D
    Next J
        
    Range("AW2:BG" & Rows.Count).ClearContents

    Indice = 0
      For D = 1 To 70
        For K = 1 To 70
          For L = 1 To 70
            For M = 1 To 70
              If Tablo(D, K, L, M) > 0 Then
                Indice = Indice + 1
                Resultat(1, 1) = D
                Resultat(1, 2) = K
                Resultat(1, 3) = L
                Resultat(1, 4) = M
                Resultat(1, 5) = Tablo(D, K, L, M)
                Cells(1 + Indice, "AW").Resize(1, 5) = Resultat

              End If
            'End If
            Next M
          Next L
        Next K
      Next D
    
    Range("AW2:BA" & Indice + 1).Copy
    Range("BC2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                              SkipBlanks:=False, Transpose:=False
              
    With ActiveSheet.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("BG2:BG" & Indice + 1), SortOn:=xlSortOnValues, _
                      Order:=xlDescending, DataOption:=xlSortNormal
      .SetRange Range("BC2:BG" & Indice + 1)
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
   
'tri BC:BF
    For J = 2 To 23
      Range("BC" & J).Resize(1, 4).Copy
      Cells(2 + ((J - 2) * 4), "BJ").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next J
          
'fin tri BC:BF
      Range("$BJ$2:$BJ$89").RemoveDuplicates Columns:=1, Header:=xlNo
'colonne BJ rangée en BP
    Dim vLigne As Long
    vLigne = Range("BP65536").End(xlUp).Row + 1
    If vLigne < 2 Then vLigne = 2
    Range("BJ2:BJ26").Copy
    Range("BP" & vLigne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=True
      
  Next Ligne
  Range("Y2:AR3012").ClearContents
  Range("AW2:BG" & Rows.Count).ClearContents

  Application.CutCopyMode = False
  Columns("BP:CN").EntireColumns.AutoFit
   Range("AT1").Offset(I, 0).Select
   
   Call Macro_Atester
   
End Sub

Quel est la bonne formulation a inscrire.
merci

 

[Yaloo]

Re : ce code est-il correct

Bonsoir jad73,

Bizarre lorsque tu lances ta macro, à la fin de celle-ci, tu le relances ????

Bon pour la copie, Ligne correspond à quoi car tu mets

For Ligne = 2 To Range("BN" & Rows.Count).End(xlUp).Row

mais tu ne copies que sur une seule ligne. Soit tu mets Ligne = 2 soit tu décales également la copie vers le bas.

A+

Martial

PS : avec un fichier en exemple ce serait plus facile.

 

[jad73]

Re : ce code est-il correct

bonjour Yaloo, le forum
merci pour ta réponse, effectivement la macro ce relance pour s'exécuter jusqu'à la fin des couplés en col BN:BO
Le principe de la macro c'est qu'a l'origine je l'effectuer 1 couplé a la fois que j'écrivais en U1:V1, comme c'est assez long il y a 34 couplés a traiter j'ai voulu la faire en automatique c'est a dire inscrire le premier couplé(BN2:BO2) en U1:V1, la macro s'exécute puis recommence mais en prenant le deuxieme couplé(BN3:BO3) l'inscrit en U1:V1 s'exécute ainsi de suite jusqu'à la fin des couplés des col BN:BO. Le probleme c'est que je n'ai pas le meme résultat en manuel qu'en automatique, en CS2 se trouve les résultats en auto et en CS9 ceux en manuel, seule le premier couplé est pareil.D'ou vient l'erreur?
je joint le fichier
merci

 

[Yaloo]

Re : ce code est-il correct

Re,

Désolé, j'ai regardé mais ça m'a planté Excel. Je ne sais pas trop pourquoi, peut-être car trop de données.

Vois avec d'autres s'ils peuvent te dépanner.

Martial