Ranger des données

Sub Copier_Etapes_de_Fabrication()
Derlig = Sheets("RecapProg").Range("B" & Sheets("RecapProg").Rows.Count).End(xlUp).Row
Set c = Columns(1).Find("Principales étapes de fabrication:", LookIn:=xlValues, lookat:=xlWhole)
Set c1 = Columns(1).Find("Difficulté:", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
  X = c1.Row - 1 - c.Row
  Range("A1").Copy Destination:=Sheets("RecapProg").Range("A" & Derlig + 1).Resize(X, 1)
  Range("A" & c.Row + 1 & ":A" & c1.Row - 1).Copy Destination:=Sheets("RecapProg").Range("B" & Derlig + 1)
End If
End Sub

Sub Copier_Les_Ingrédients()
'Affiche dans la feuille "RecapIng", les ingrédients nécessaires pour chaque recette
'Derlig = 1
Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    'Recherche dans la colonne A la chaine de caractères "Marchandise"
   Set c = .Columns(1).Find("Marchandise", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Notes :"
   Set c1 = .Columns(1).Find("Notes :", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
      X = c1.Row - 3 - c.Row
      .Range("A1").Copy Destination:=Sheets("RecapIng").Range("A" & Derlig).Resize(X, 1)
      .Range("A" & c.Row + 1 & ":C" & c1.Row - 3).Copy Destination:=Sheets("RecapIng").Range("B" & Derlig).Resize(X, 3)
      Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
    End If
  End With
Next K
End Sub

Sub Copier_Etapes_de_Fabrication()
'Affiche dans la feuille "RecapProg", les différentes tâches à effectuer pour chaque recette
Derlig = Sheets("RecapProg").Range("A" & Sheets("RecapProg").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    'Recherche dans la colonne A la chaine de caractères "Principales étapes de fabrication:"
    Set c = .Columns(1).Find("Principales étapes de fabrication:", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Difficulté:"
    Set c1 = .Columns(1).Find("Difficulté:", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
      X = c1.Row - 1 - c.Row
      .Range("A1").Copy Destination:=Sheets("RecapProg").Range("A" & Derlig).Resize(X, 1)
      .Range("A" & c.Row + 1 & ":A" & c1.Row - 1).Copy Destination:=Sheets("RecapProg").Range("B" & Derlig).Resize(X, 1)
      Derlig = Sheets("RecapProg").Range("A" & Sheets("RecapProg").Rows.Count).End(xlUp).Row + 1
    End If
  End With
Next K
End Sub

Sub Copier_Les_Ingrédients()
'Affiche dans la feuille "RecapIng", les ingrédients nécessaires pour chaque recette
'Derlig = 1
Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    'Recherche dans la colonne A la chaine de caractères "Marchandise"
  Set c = .Columns(1).Find("Marchandise", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Notes :"
  Set c1 = .Columns(1).Find("Notes :", LookIn:=xlValues, lookat:=xlWhole)
  'n = nombre de cellules vides + 1 dans la plage concernée
  n = Application.CountBlank(.Range("A" & c.Row & ":A" & c1.Row)) + 1
    If Not c Is Nothing Then
      X = c1.Row - n - c.Row
      .Range("A1").Copy Destination:=Sheets("RecapIng").Range("A" & Derlig).Resize(X, 1)
      .Range("A" & c.Row + 1 & ":C" & c1.Row - n).Copy Destination:=Sheets("RecapIng").Range("B" & Derlig).Resize(X, 3)
      Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
    End If
  End With
Next K
End Sub

Sub Copier_Les_Ingrédients2()
'Affiche dans la feuille "RecapIng", les ingrédients nécessaires pour chaque recette
'Derlig = 1
Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    'Recherche dans la colonne A la chaine de caractères "Marchandise"
    Set c = .Columns(1).Find("Marchandise", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Notes :"
    Set c1 = .Columns(1).Find("Notes :", LookIn:=xlValues, lookat:=xlWhole)
    'X = nombre de cellules pleines dans la plage concernée
    X = .Range("A" & c.Row & ":A" & c1.Row).SpecialCells(xlCellTypeConstants).Count
    If Not c Is Nothing Then
      If X > 2 Then
        .Range("A1").Copy Destination:=Sheets("RecapIng").Range("A" & Derlig).Resize(X - 2, 1)
        .Range("A" & c.Row + 1 & ":C" & c1.Row - 1).SpecialCells(xlCellTypeConstants).Copy Destination:=Sheets("RecapIng").Range("B" & Derlig).Resize(X - 2, 3)
      End If
      Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
    End If
  End With
Next K
End Sub

Sub Copier_Les_Ingrédients2()
'Affiche dans la feuille "RecapIng", les ingrédients nécessaires pour chaque recette
'Derlig = 1
Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    'Recherche dans la colonne A la chaine de caractères "Marchandise"
    Set C = .Columns(1).Find("Marchandise", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Notes :"
    Set c1 = .Columns(1).Find("Notes :", LookIn:=xlValues, lookat:=xlWhole)
    If Not C Is Nothing And Not c1 Is Nothing Then
      Zone = .Range("A" & C.Row + 1 & ":C" & c1.Row - 1)
      Zone1 = .Range("A" & C.Row & ":A" & c1.Row)
      If UBound(Zone1, 1) > 2 Then
        .Range("A1").Copy Destination:=Sheets("RecapIng").Range("A" & Derlig).Resize(UBound(Zone, 1), 1)
        'Copie la zone dans la feuille ("RecapIng")
       .Range("A" & C.Row + 1 & ":C" & c1.Row - 1).Copy Destination:=Sheets("RecapIng").Range("B" & Derlig).Resize(UBound(Zone, 1), UBound(Zone, 2))
      End If
    End If
    Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
  End With
Next K
Derlig1 = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row
Sheets("RecapIng").Range("B1:B" & Derlig1).Replace " ", ""
nbr = Application.CountIf(Sheets("RecapIng").Range("B1:B" & Derlig1), "")
If nbr = 0 Then Exit Sub
Sheets("RecapIng").Range("B1:B" & Derlig1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'On Error Resume Next
'If Sheets("RecapIng").Range("B1:B" & Derlig1).SpecialCells(xlCellTypeBlanks) Is Nothing Then Exit Sub
'Sheets("RecapIng").Range("B1:B" & Derlig1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Sub Copier_Les_Ingrédients2()
'Affiche dans la feuille "RecapIng", les ingrédients nécessaires pour chaque recette
nCol = 3
ReDim oRcp(1 To nCol, 1 To 1)
Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
If Derlig = 2 Then Derlig = 1
'Parcourt les 2 premières recettes : à adapter (boucle for each)
For K = 1 To 2
  With Sheets(K)
    nLig = 0: Derlig1 = .Range("A" & .Rows.Count).End(xlUp).Row
    'boucle pour supprimer les espaces superflus dans les cellules vides
    'On ne sait jamais!!!
    For Each Cell In .Range("A1:A" & Derlig1)
      If InStr(1, Cell.Value, Chr(32)) Then Cell.Value = Trim(Cell)
    Next
    'Recherche dans la colonne A la chaine de caractères "Marchandise"
    Set c = .Columns(1).Find("Marchandise", LookIn:=xlValues, lookat:=xlWhole)
    'Recherche dans la colonne A la chaine de caractères "Notes :"
    Set c1 = .Columns(1).Find("Notes :", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing And Not c1 Is Nothing Then
      Zone = .Range("A" & c.Row & ":C" & c1.Row)
      If UBound(Zone, 1) > 2 Then
        X = Application.CountBlank(.Range("A" & c.Row & ":A" & c1.Row))
        If UBound(Zone, 1) > X + 2 Then
          For i = 2 To UBound(Zone, 1) - 1
            If Not IsEmpty(Zone(i, 1)) Then
              nLig = nLig + 1
              ReDim Preserve oRcp(1 To nCol, 1 To nLig)
              For j = 1 To nCol
                oRcp(j, nLig) = Zone(i, j)
              Next j
            End If
          Next i
          Sheets("RecapIng").Range("A" & Derlig).Resize(nLig, 1) = .Range("A1")
          Sheets("RecapIng").Range("B" & Derlig).Resize(nLig, nCol) = WorksheetFunction.Transpose(oRcp)
        End If
      End If
    End If
    Derlig = Sheets("RecapIng").Range("A" & Sheets("RecapIng").Rows.Count).End(xlUp).Row + 1
  End With
Next K
End Sub