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

Résolu

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention - 25 avril 2022 à 10:58

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

A voir également:

Rajouter par VBA des lignes vides et des sommes dans un tabl
Table des matières word - Guide
Partager des photos en ligne - Guide
Table des caractères - Guide
Afficher des lignes masquées excel ✓ - Forum Excel
Excel trier par ordre alphabétique en gardant les lignes - Guide

1 réponse

Réponse 1 / 1

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 2

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

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584

bonjour, peux-tu alors marquer la discussion comme résolue?

Discussions similaires

Table des matières dont les titres n'apparaissent pas..

Intégrer une table des annexes et des matières sur word

EXCEL : Supprimer des lignes vides à la fin

insérer une table d'illustration

Sommaire + Table des matières + Table des Annexes

Votre réponse

Discussions similaires