XL 2010 Transfert certaines données vers une autre feuille VBA

[Mojojo53]

Bonjour,
J’aimerais transférer certaines données d’une feuille Excel vers une autre feuille sous forme de base de donnée.
Je vous joint mon fichier pour mieux comprendre.

j’ai essayé plein de chose mais mais connaissance en VBA sont limités.

 

[danielco]

Bonjour,

Euh, oui, quelle données ? Il n'y a pas de données ?

Cordialement.

Daniel

 

[Mojojo53]

Si, j’aimerais transférer que les données en bleue.

 

[danielco]

Est-ce que tu peux donner un exemple ?

Daniel

 

[Mojojo53]

Par exemple en
-A10: correspond à ma ligne de production
- M10 : correspond à une certaine machine sur la ligne
- N10 : correspond à un type d’arrêt ou de panne
- O10 : correspond au temps d’arrêt
- P10 : commentaire

En M8 cellule fusionnée : temps d’arrêt.
Il peut y avoir plusieurs lignes de remplis sur un poste (sois 8h).
Chaque chef d’équipe saisie les pannes qu’il a eu pendant son poste.
J’aimerais créer une base de données pour fiabiliser les machines critiques

 

[danielco]

Pourquoi il y a des lignes vides ? Où prend-on la date ?

Daniel

 

[Mojojo53]

Je vais mettre plus de commentaire dans le fichier exemple pour mieux comprendre la demande.

 

[Mojojo53]

Voici le fichier avec des données et commentaires.

 

[danielco]

Bonjour,

Essaie :

Sub Transfert()
  Dim C As Range, Ligne As Long, Plage As Range, EH As Variant, X As Range, L As Long
  With Sheets("Récap CEq")
    Set Plage = .Range("A10", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  With Sheets("explication écarts")
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each C In Plage
'      If C.Value = "LONGES" Then Stop
      If C <> "" Then
        With Sheets("Récap CEq")
          EH = ""
          L = C.Row
          Do Until EH <> ""
            EH = .Cells(L, 10)
            L = L + 1
          Loop
        End With
        Set X = Sheets("Récap CEq").Cells(C.Row, 12)
        Do While Sheets("Récap CEq").Cells(X.Row, 13) <> ""
          Ligne = Ligne + 1
          .Cells(Ligne, 1) = Sheets("Récap CEq").[D1]
          .Cells(Ligne, 2) = C
          .Cells(Ligne, 3) = Sheets("Récap CEq").Cells(X.Row, 13)
          .Cells(Ligne, 4) = Sheets("Récap CEq").Cells(X.Row, 14)
          .Cells(Ligne, 5) = Sheets("Récap CEq").Cells(X.Row, 15)
          .Cells(Ligne, 6) = EH
          .Cells(Ligne, 7) = Sheets("Récap CEq").Cells(X.Row, 16)
          Set X = X.Offset(1)
        Loop
        End If
    Next C
  End With
End Sub

Daniel