XL 2019 Aide VBA extraire ligne

thomzx

XLDnaute Nouveau
Bonjour,

je souhaiterais créer une Macro qui extrait des données de ma Table 1 vers une autre feuille, en prenant ligne par ligne et en en ajoutant une autre en dessous à chaque fois, le tout en ne recopiant pas les lignes ou il y a des choses inutiles marquées. J'ai créé une ébauche d'algorithme mais je n'arrive pas à le retransposer en VBA je ne connais pas assez le langage

63811883802__5F866240-D3E0-42DD-8948-8657C35232BA.jpg


Et voici le code VBA que j'ai essayé de faire
Sub Thomas()

Sheets.Add
ActiveSheet.Name = "feuille"
Dim i As Integer
For i = 2 To 600
Worksheets("Table 1").Activate
If ((Cells(i, 2).IsText) And Cells(i, 4).IsNumeric) Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 9)).Select
Selection.Copy
Sheets("feuille").Activate
Cells(Rows.Count, colonne).End(xlUp).Row.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub

(pas encore fini)

Merci beaucoup pour votre aide c'est la première fois que j'essaye de coder
 

Pièces jointes

  • 07 2020 2 macro.xlsx
    19.5 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Thomas,
Ce qui est en dessous ne plante pas, mais je ne suis pas sur que cela fasse ce que vous voulez. :)
J'ai fait en sorte de toucher le moins possible à votre code.
VB:
Sub Thomas()
    Application.ScreenUpdating = False  ' Fige écran pour accélerer
    Sheets.Add
    ActiveSheet.Name = "feuille"
    Dim i As Integer
    For i = 2 To 600
        Worksheets("Table 1").Activate
        If WorksheetFunction.IsText(Cells(i, 2)) And IsNumeric(Cells(i, 4)) Then
            ActiveSheet.Range(Cells(i, 2), Cells(i, 9)).Select
            Selection.Copy
            Sheets("feuille").Activate
            Cells(1 + Range("A65500").End(xlUp).Row, 1).Select ' Selection première cellule vide
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next
End Sub
Sur ce site pour livrer du code utilisez les balises </>, c'est plus lisible.
Pensez à indenter votre code, là aussi c'est plus lisible.
 

thomzx

XLDnaute Nouveau
Bonsoir Thomas,
Ce qui est en dessous ne plante pas, mais je ne suis pas sur que cela fasse ce que vous voulez. :)
J'ai fait en sorte de toucher le moins possible à votre code.
VB:
Sub Thomas()
    Application.ScreenUpdating = False  ' Fige écran pour accélerer
    Sheets.Add
    ActiveSheet.Name = "feuille"
    Dim i As Integer
    For i = 2 To 600
        Worksheets("Table 1").Activate
        If WorksheetFunction.IsText(Cells(i, 2)) And IsNumeric(Cells(i, 4)) Then
            ActiveSheet.Range(Cells(i, 2), Cells(i, 9)).Select
            Selection.Copy
            Sheets("feuille").Activate
            Cells(1 + Range("A65500").End(xlUp).Row, 1).Select ' Selection première cellule vide
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next
End Sub
Sur ce site pour livrer du code utilisez les balises </>, c'est plus lisible.
Pensez à indenter votre code, là aussi c'est plus lisible.
Bonsoir,
Vous êtes incroyable ! Mille mercis
Maintenant il faut juste que j'arrive à ajouter ma ligne en plus entre chaque ligne qui doit reprendre la date de la ligne du dessus (colonne 1 de Feuille), un numéro de compte identique (51200002), un libellé identique (colonne 4 de Feuille), marquer FAUX dans la colonne 6 de feuille et ensuite mettre un nombre dans la case diagonale en fonction du sens débit/ crédit. Ex, si la première écriture il y a 178,5 dans la colonne de droite, je dois mettre 178,5 dans la colonne de gauche une ligne en dessous.

Dans tous les cas vous m'avez déjà bien aidé en me fournissant une base solide pour finir mon 1er code, merci encore et bonne soirée
 

thomzx

XLDnaute Nouveau
Bonsoir le fil

[Une suggestion en passant]
Regarde la pièce jointe 1099774
[/Une suggestion en passant]
Si je ne suis pas dans la cible, c'est pas grave, je ne faisais que passer ;)
Merci pour la suggestion ca peut etre utile pour vérifier qu'il n'y a pas d'erreur. Dans mon cas je dois laisser dans l'ordre les écritures pour faire du traitement massif. Ca peut être pas mal pour de la révision ou de l'audit en tout cas
 
Haut Bas