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 -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
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 -
- RESULTAT SOUHAITE -

- RESULTAT QUE J'OBTIENS AVEC LA MACRO QUE J'AI PROGRAMME -

- ONGLET BDGT -

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
- Table des annexes word ✓ - Forum Word
- Afficher des lignes masquées excel ✓ - Forum Excel
1 réponse
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
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?