Rajouter par VBA des lignes vides et des sommes dans un tabl Résolu

Question

Bonjour,

J'ai programmé un code VBA qui permet de créer un tableau à partir d'une base de données cependant je souhaiterai rajouter des lignes vides (entre les RISK et OPPOR) et des sommes dans le tableau (dans la colonne RAF) mais je n'y arrive pas.

Est-ce que vous pouvez rajouter des lignes vides et des sommes en VBA dans mon codage pour que cela se rajoute dans mon tableau?

J'ai joint un fichier illustratif => Le lien a été crée : https://www.cjoint.com/c/LDziEba1xFO
Merci de votre aide

- VBA QUE J'AI PROGRAMME -

Option Explicit

Sub Extraire()
Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer, dest As Range
Set ws = ThisWorkbook.Worksheets("Détail des risques")

With Sheets("BDGT")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If cel.Offset(, 1) Like "*RISK*" Then
dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("I" & dt) = cel.Offset(, 6)
End If

Next cel
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("BDGT")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If cel.Offset(, 1) Like "*OPPOR*" Then

dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("I" & dt) = cel.Offset(, 6)
End If

Next cel
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub

        EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

- RESULTAT SOUHAITE -



- RESULTAT QUE J'OBTIENS AVEC LA MACRO QUE J'AI PROGRAMME -


- ONGLET BDGT -




Configuration: Windows / Chrome 100.0.4896.127

Dreampower75 · Answer

Bonjour Forum

J'ai trouvé la solution :

Merci beaucoup

Sub Extraire()
    Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer, dest As Range
    Dim Deb As Long
    Set ws = ThisWorkbook.Worksheets("Détail des risques")
    With ws
        .UsedRange.Offset(21, 0).Clear
    End With

    With Sheets("BDGT")
        For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

             If cel.Offset(, 1) Like "*RISK*" Then
                 dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

                 ws.Range("A" & dt) = cel.Offset(, 1)
                 ws.Range("B" & dt) = cel.Offset(, 2)
                 ws.Range("I" & dt) = cel.Offset(, 6)
             End If

        Next cel
        
    End With
    With ws
        .Range("A" & dt + 1) = "Total"
        .Range("I" & dt + 1).Formula = "=sum(I22:I" & dt & ")"
    End With
    dt = dt + 4 '+4 à ajuster selon le nombre de lignes à insérer
    Deb = dt 'sauvegarde de la première ligne pour les OPPORT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
    With Sheets("BDGT")
        For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

             If cel.Offset(, 1) Like "*OPPOR*" Then
 
                 'dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

                 ws.Range("A" & dt) = cel.Offset(, 1)
                 ws.Range("B" & dt) = cel.Offset(, 2)
                 ws.Range("I" & dt) = cel.Offset(, 6)
                 dt = dt + 1
             End If

        Next cel
    End With
    With ws
        .Range("A" & dt) = "Total"
        .Range("I" & dt).Formula = "=sum(I" & Deb & ":I" & dt & ")"
    End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub

Rajouter par VBA des lignes vides et des sommes dans un tabl

1 réponse

Discussions similaires

Newsletters