Discussion :

[onyirimba]

Bonjour

Est-il possible de programmer en VBA le fait que les données supérieur surlignés en jaune du tableau soient collés dans l'onglet "ALL RM" dans les colonnes correspondantes et que les données inférieur du tableau soient collés dans l'onglet "ALL FU" sachant que ces données peuvent augmenter ou diminuer d'un mois à l'autre au niveau du nombre de lignes
exemple : Pour le mois de 09 2021 => les données liées à l'onglet "ALL RM" se terminent à la ligne 14 (voir excel ci-joint)
Pour le mois de 10 2021 => ces données peuvent se terminer à la ligne 24



Idem pour les données liés à l'onglet "ALL FU"

j'ai essayé avec le code ci-après mais cela ne fonctionne pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Maj()
Const Formule As String = "=IFERROR(G@/F@,0)"
Dim Bdd As Range, Destination As Range
Dim nbLignes As Long
'
' toutes les données de bdd
With ThisWorkbook.Sheets("BDD ").Range("B6").CurrentRegion
Set Bdd = .Offset(2).Resize(.Rows.Count - 2)
End With
'
' nombre de lignes
nbLignes = Bdd.Rows.Count
'
' destination des nouvelles données
With ThisWorkbook.Sheets("ALL RM").Range("B1").CurrentRegion
'
' Ligne suivante du tableau, retaillée au nombre de lignes
With .Offset(.Rows.Count).Resize(nbLignes)
' Transfert des valeurs.
.Columns(1).Value = "Sep 21"
.Columns(2).Resize(, 3).Value = Bdd.Columns(2).Resize(, 3).Value
.Columns(5).Value = Bdd.Columns(6).Value
.Columns(6).Value = Bdd.Columns(8).Value
.Columns(7).Formula = Replace(Formule, "@", .Row)
End With
 
End With
 
End Sub

J'ai joint un fichier Excel illustrant mes propos.

Merci d'avance pour votre aide
Cordialement

[EricDgn]

Bonjour,

Une façon de faire, à adapter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
'--- présupposé
'--- feuille BDD, en colonne I:
'---    a) dernière ligne = dernière ligne groupe FU
'          et groupe FU jamais vide
'---    b) une ligne vide sépare groupe FU du groupe RM
'---    c) une ligne vide sépare group RM de la ligne de titres
'          et groupe RM jamais vide
'---    d) en B5: la date (contenant le mois)
'---    e) reprend les valeurs, ne reprend pas les formats
'---       (à mettre de préférence sur les colonnes entières)
 
Sub Reprise()
    Dim wshBDD As Worksheet, wshRM As Worksheet, wshFU As Worksheet
    Dim kR1 As Long, kR2 As Long, kRRM As Long, kRFU As Long
    Dim sMois As String, kR As Long, i As Long
    Set wshBDD = ThisWorkbook.Worksheets("BDD")         '--- "BDD" ou "BDD "
    Set wshRM = ThisWorkbook.Worksheets("ALL RM")
    Set wshFU = ThisWorkbook.Worksheets("ALL FU")
    wshBDD.Select
    sMois = Format(Range("B5"), "mmm yy")
    With wshFU
        kR2 = Cells(Rows.Count, 9).End(xlUp).Row        '--- 9 = colonne I
        kR1 = Cells(kR2, 9).End(xlUp).Row               '--- 9 = colonne I
        kRFU = .Cells(Rows.Count, 2).End(xlUp).Row      '--- 2 = colonne B
        Debug.Print kR1, kR2, kRFU
        For kR = kR1 To kR2
            kRFU = kRFU + 1
            .Range("B" & kRFU) = sMois
            .Range("C" & kRFU) = Range("I" & kR).Text
            .Range("D" & kRFU) = Range("J" & kR).Text
            .Range("F" & kRFU) = Range("K" & kR)
            .Range("G" & kRFU) = Range("M" & kR)
        Next kR
    End With
    With wshRM
        kR2 = kR1 - 2                         '--- une ligne vide sépare groupe FU du groupe RM
        kR1 = Cells(kR2, 9).End(xlUp).Row               '--- 9 = colonne I
        kRRM = .Cells(Rows.Count, 2).End(xlUp).Row      '--- 2 = colonne B
        Debug.Print kR1, kR2, kRRM
        For kR = kR1 To kR2
            kRRM = kRRM + 1
            .Range("B" & kRRM) = sMois
            .Range("C" & kRRM) = Range("I" & kR).Text
            .Range("D" & kRRM) = Range("J" & kR).Text
            .Range("F" & kRRM) = Range("K" & kR)
            .Range("G" & kRRM) = Range("M" & kR)
        Next kR
    End With
    Set wshBDD = Nothing
    Set wshRM = Nothing
    Set wshFU = Nothing
End Sub

Cordialement.