Sélection par macro

Bonsoir !

Je suis de retour pour un nouveau problème pour vous.

Il y a des données d'achat et des données de vente. Les données d'achat apparaissent en premier et en dessous les ventes. ( tout dans la colonne A )

Le but est de sélectionner les données dans la colonne A à certains endroits c'est à dire les chiffres dans mon exemple qui font 19 lignes par lot et séparé par des titres inutile qui font 4 lignes. Tout cela ce répète jusqu'à la fin des achats qui fait un nombre de ligne variable entre 1 et 19. Tout dépend de ce qui reste à la fin du dernier lot. Pareillement pour la fin des ventes.

Une fois la sélection maîtrisé soit lot par lot ou sinon directement l'intégralité des lots d'achats en tenant compte de la dernière variable, idem ventes. Je souhaite coller cette sélection dans les colonnes d'achat et vente.

Je vous joint l'exemplaire avec commentaires pour vous guider et éclaircir ce que je souhaite.

Bonne chance et bonne soirée Merci !

PS: J'ai pensé a supprimer les lignes inutiles par 4 mais après il faut savoir que la suppression doit s’arrêter à la fin des achats puis faire un copier coller dans la colonne des achats puis reprendre sur les ventes peut être qu'il est possible, mais il faudrait un macro qui fassent Si cellule = Vente alors stop la suppression ensuite sélectionner puis feuille 2 puis coller A1.

Excusez moi pour avoir fait long ^^

Salut Dettox,

voici ton fichier, à tester en situation réelle!

Private Sub cmdGO_Click()
'
Dim tTab, tTabF()
'
iRow = Cells(Rows.Count, 1).End(xlUp).Row
tTab = Range("A1:A" & iRow)
'
Application.ScreenUpdating = False
'
With Worksheets("Recap")
    .UsedRange.Delete
    iFlag = 1
    For x = 1 To UBound(tTab)
        If UCase(Right(tTab(x, 1), 6)) = "VENTES" And iFlag = 1 Then
            iFlag = 2
            .Range("A1") = "Achats"
            .Range("A2").Resize(iIdx) = WorksheetFunction.Transpose(tTabF)
            Erase tTabF
            iIdx = 0
        End If
        If IsNumeric(tTab(x, 1)) And tTab(x, 1) <> "" Then
            iIdx = iIdx + 1
            ReDim Preserve tTabF(1, iIdx)
            tTabF(0, iIdx - 1) = tTab(x, 1)
        End If
    Next
    .Range("B1") = "Ventes"
    .Range("B2").Resize(iIdx) = WorksheetFunction.Transpose(tTabF)
    .Range("A1:B1").Interior.Color = RGB(215, 215, 215)
    .UsedRange.Borders.LineStyle = 1
    .Activate
End With
'
Application.ScreenUpdating = True
'
End Sub

Bon travail!

A+

Salut curulis57,

Grand merci pour le code que tu as crée.

Je voulais savoir une chose à propos de cela. Si je veux modifier le nom Achat et Vente ( les titres des deux colonnes sur "Extract") mais suivant la même principe seulement je veux modifier Achat à "ANIMAUX PRESENTS EN FIN DE PERIODE" et pour Ventes "ANIMAUX SORTIS EN COURS DE PERIODE"

Si tu pouvais m'expliquer comment tu procède pour effectuer ce changement ca serait sympa !

Merci et bonne journée,

Dettox

Salut Dettox,

comme cela, sans doute...

Private Sub cmdGO_Click()
'
Dim tTab, tTabF()
'
iRow = Cells(Rows.Count, 1).End(xlUp).Row
tTab = Range("A1:A" & iRow)
'
Application.ScreenUpdating = False
'
With Worksheets("Recap")
    .UsedRange.Delete
    iFlag = 1
    For x = 1 To UBound(tTab)
        If UCase(Mid(tTab(x, 1), 9, 6)) = "SORTIS" And iFlag = 1 Then
            iFlag = 2
            .Range("A1") = "ANIMAUX PRESENTS EN FIN DE PERIODE"
            .Range("A2").Resize(iIdx) = WorksheetFunction.Transpose(tTabF)
            Erase tTabF
            iIdx = 0
        End If
        If IsNumeric(tTab(x, 1)) And tTab(x, 1) <> "" Then
            iIdx = iIdx + 1
            ReDim Preserve tTabF(1, iIdx)
            tTabF(0, iIdx - 1) = tTab(x, 1)
        End If
    Next
    .Range("B1") = "ANIMAUX SORTIS EN COURS DE PERIODE"
    .Range("B2").Resize(iIdx) = WorksheetFunction.Transpose(tTabF)
    .Range("A1:B1").Interior.Color = RGB(215, 215, 215)
    .UsedRange.Borders.LineStyle = 1
    .Activate
End With
'
Application.ScreenUpdating = True
'
End Sub

A tester si cela te convient!

A+

Bonjour curulis

Je te remercie pour ton aide !

Bonne journée a toi