Assembler plusieurs macro pour n'en faire qu'une

Bonjour,

J'ai 12 macros comme celles ci-dessous qui travaillent sur une même feuille.

Sub chaines_cpa1()
Dim i As Integer, j As Integer
Dim Chaine As String
  Range("AJ24") = ""
If WorksheetFunction.CountIf(Range("D14:AH14"), "Cpa") Then
For i = 4 To 34
    If Cells(14, i) = "Cpa" Then
        For j = i To 35
            If Cells(14, j) <> "Cpa" Then
                If Chaine = "" Then
                Chaine = "   du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
                Else
                Chaine = Chaine & "        et du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
                End If
            i = j
            Exit For
            End If
        Next
    End If
Next
End If
  Range("AJ24") = Chaine
End Sub
Option Explicit

Sub chaines_css1()
Dim i As Integer, j As Integer
Dim Chaine As String
  Range("AJ25") = ""
If WorksheetFunction.CountIf(Range("D14:AH14"), "Css") Then
For i = 4 To 34
    If Cells(14, i) = "Css" Then
        For j = i To 35
            If Cells(14, j) <> "Css" Then
                If Chaine = "" Then
                Chaine = "   du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
                Else
                Chaine = Chaine & "        et du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
                End If
            i = j
            Exit For
            End If
        Next
    End If
Next
End If
  Range("AJ25") = Chaine
End Sub

Sachant que la différence entre elles est le critère recherché et en fonction de ce critère l'emplacement du Range, est-il possible de les assembler pour n'en faire qu'une ?

Si oui pouriez-vous maiguiller svp

.

Bonjour

Essayes un truc comme ça

Option Explicit

Sub chaines_cpa1()
Dim i As Integer, j As Integer
Dim Chaine As String
Dim Recherche, K As Integer

  Recherche = Array("Cpa", "Css")
  For K = 0 To UBound(Recherche)
    Range("AJ" & 24 + K) = ""
    If WorksheetFunction.CountIf(Range("D14:AH14"), Recherche) Then
      For i = 4 To 34
        If Cells(14, i) = Recherche Then
          For j = i To 35
            If Cells(14, j) <> Recherche Then
              If Chaine = "" Then
                Chaine = "   du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
              Else
                Chaine = Chaine & "        et du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
              End If
              i = j
              Exit For
            End If
          Next j
        End If
      Next i
    End If
    Range("AJ" & 24 + K) = Chaine
  Next K
End Sub

Bonjour Banzai64,

Merci de ton aide

J'obtiens cette erreur

Erreur d'éxécution '13':

incompatibilité de type

Et ce bout de code est surligné

If WorksheetFunction.CountIf(Range("C14:AG14"), Recherche) Then

.

Bonjour

Oui c'est vrai car pas de fichier --> pas testé (même le minimum)

Option Explicit

Sub chaines_cpa1()
Dim i As Integer, j As Integer
Dim Chaine As String
Dim Recherche, K As Integer

  Recherche = Array("Cpa", "Css")
  For K = 0 To UBound(Recherche)
    Range("AJ" & 24 + K) = ""
    If WorksheetFunction.CountIf(Range("D14:AH14"), Recherche(K)) Then
      For i = 4 To 34
        If Cells(14, i) = Recherche(K) Then
          For j = i To 35
            If Cells(14, j) <> Recherche(K) Then
              If Chaine = "" Then
                Chaine = "   du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
              Else
                Chaine = Chaine & "        et du    " & Cells(10, i) & "  au  " & Cells(10, j - 1)
              End If
              i = j
              Exit For
            End If
          Next j
        End If
      Next i
    End If
    Range("AJ" & 24 + K) = Chaine
  Next K
End Sub

Voilà j'espère n'avoir rien oublié

Re

Banzai64 a écrit :

Bonjour

Oui c'est vrai car pas de fichier --> pas testé (même le minimum)

Encore un détail, mais d'importance, les dates se répètent de ligne en ligne, hors seules les dates liées à un critère doivent être prisent en compte.

Bonjour

Il faut réinitialiser la variable Chaine

'
'
If WorksheetFunction.CountIf(Range("D14:AH14"), Recherche(K)) Then
 Chaine = ""
  For i = 4 To 34
'
'

Re,

Excelent

Merci