Extraction de données et mise sur une ligne

bonjour à tous

je dois contrôler les connections à un logiciel d'enregistrement de résultat de pétanque. La fenêtre des connections ce présente sous cette forme.

j'ai moyen de sélectionner les lignes et de les copier. Sauf que dans Excel il me colle les lignes comme ci dessous

j'ai essayé de faire ça et me disant que j'aurai plus qu'a trier les lignes ou j'ai des résultats (fond bleu)

Sub copieligne()

Dim ligne As Integer, ligne1 As Integer, ligne2 As Integer

ligne = 2
ligne1 = 1
ligne2 = 1
Do While Cells(ligne2, 1).Value <> ""
Cells(ligne, 1).Value = Sheets("exportation liste").Cells(ligne1, 1).Value
Cells(ligne, 2).Value = Sheets("exportation liste").Cells(ligne1 + 1, 1).Value
Cells(ligne, 3).Value = Sheets("exportation liste").Cells(ligne1 + 2, 1).Value
ligne = ligne + 1
ligne2 = ligne2 + 1
ligne1 = ligne1 + 3
Loop
End Sub

Sauf que la ligne copié avec un résultat = 4 lignes collées

serait il possible de tester le nombre de ligne en 2 dates de connexions et de mette un if Si nombre de ligne =2 j'applique mon vba si nombre de ligne =3

Sub copieligne()

Dim ligne As Integer, ligne1 As Integer, ligne2 As Integer

ligne = 2
ligne1 = 1
ligne2 = 1
Do While Cells(ligne2, 1).Value <> ""
Cells(ligne, 1).Value = Sheets("exportation liste").Cells(ligne1, 1).Value
Cells(ligne, 2).Value = Sheets("exportation liste").Cells(ligne1 + 1, 1).Value
Cells(ligne, 3).Value = Sheets("exportation liste").Cells(ligne1 + 2, 1).Value
cells(ligne,4).value = Sheets("exportation liste").Cells(ligne1 + 3, 1).Value
ligne = ligne + 1
ligne2 = ligne2 + 1
ligne1 = ligne1 + 3
Loop
End Sub

Pour information j'ai 2000 lignes à traiter sur 2.5 journées et j'ai 10 journées , je ne me vois pas contrôler ligne par ligne manuellement. les lundis matin.

je reste à disposition ppour plus d'information et je vous remercie par avance de votre aide.

philippe87

Bonjour

Essayez le code comme ceci

Sub test()
Dim c As Range
Dim prem As String
Dim dlg As Integer

With Sheets("exportation liste")
    Set c = .Range("A:A").Find("*rencontre*", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
       prem = c.Address
       dlg = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
       Do
           ActiveSheet.Range("A" & dlg) = .Cells(c.Row - 2, 1).Value
           ActiveSheet.Range("B" & dlg) = .Cells(c.Row - 1, 1).Value
           ActiveSheet.Range("C" & dlg) = .Cells(c.Row, 1).Value
           ActiveSheet.Range("D" & dlg) = .Cells(c.Row + 1, 1).Value

           Set c = .Range("A:A").FindNext(c)
           dlg = dlg + 1
        Loop While Not c Is Nothing And c.Address <> prem
    End If
End With
End Sub

Pour l'exécution du code, mettez vous sur la feuille "mise en forme des lignes"

Crdlt

Bonjour à vous 2

Vous pouvez également passer par un tableau, plus rapide en général

Sub CopieLigneV2()
  Dim dLig As Long, Lig As Long
  Dim LeTab(), Inc As Long
  With Sheets("exportation liste")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    Lig = 1: Inc = -1
    Do While Lig <= dLig
      Inc = Inc + 1
      ReDim Preserve LeTab(4, Inc)
      LeTab(0, Inc) = .Range("A" & Lig).Value * 1
      LeTab(1, Inc) = .Range("A" & Lig + 1).Value
      LeTab(2, Inc) = .Range("A" & Lig + 2).Value
      If Not IsDate(.Range("A" & Lig + 3)) Then
        LeTab(3, Inc) = .Range("A" & Lig + 3).Value
        Lig = Lig + 4
      Else
        LeTab(3, Inc) = ""
        Lig = Lig + 3
      End If
    Loop
  End With
  With Sheets("mise en forme des lignes")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    If dLig > 1 Then
      .Range("A2:D" & dLig).ClearContents
    End If
    .Range("A2").Resize(Inc, 4).Value = Application.Transpose(LeTab)
  End With
End Sub

A+

Hello,

Une rapide proposition PowerQuery,

Tu mets ta liste dans le premier onglet en dessous de "Colonne1" et ensuite tu fais clic droit puis "Actualiser" sur le tableau de l'onglet "Requête PQ"

Attention si tu changes le nom de la colonne

@+

Bonsoir à tous !

@BAROUTE78 : Hello

Une rapide lecture du profil du demandeur nous informe qu'il évolue sous Excel.....2007

Hello,

Ouppsss j'ai perdu cette habitude .... Si il y a des curieux ils pourront regarder

@+

bonjour as tous,

merci pour votre retour à tous, j'ai testé le fichier entiers avec les 3 proposition ça fonctionne pour moi, mais comme je souhaité pas refaire de trie pour sélectionner que les connexions ou il y avait la saisies des rencontres, je suis parti sur la proposition de Dan.

accord merci à vous tous pour votre aide et réactivité.

A+

Philippe87