Discussion :

[frisette68]

Bonjour,

Je débute sur VBA et n'arrive pas à faire ma macro. C'est pour faciliter la comptabilité d'une association.

Je souhaite copier les valeurs d'une ligne vers une autre feuille en fonction du texte que contient la colonne K.
Dans la colonne K je mets l'affectation budgétaire type "voyage", "foyer" et j'ai créer une feuille pour chacun de ces budgets avec la feuille qui est nommée selon le nom du budget.

Don à chaque fois que je mets par ex "foyer" dans le colonne K, j'aimerai que la ligne entière soit copiée dans la feuille "Foyer". Tout ceci pour toutes les lignes d'écriture qu'il y aura dans le tableau.
Ceci pour que je n'ai qu'à rentrer une seule fois la ligne d'écriture sur le tableau général.

Merci d'avance pour votre aide.

[Singular]

Cette procédure doit être placée dans le module de code de la feuille d'entrée de données:

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wks As Worksheet
    Dim c As Range
    Dim Cellule As Range
    Dim rngDest As Range
    Const NO_COLONNE As Long = 11
 
    If Target.Cells.Count > 1 Then
        For Each c In Target
            If c.Column = NO_COLONNE Then
                Set Cellule = c
                Exit For
            End If
        Next c
    Else
        If Target.Column = NO_COLONNE Then
            Set Cellule = Target
        End If
    End If
 
    If Not Cellule Is Nothing Then
        ' copier la ligne entière à la suite des données dans
        '   la feuille portant le nom donnée dans la cellule.
        If Cellule.Value = vbNullString Or IsNull(Cellule.Value) Then Exit Sub
        On Error Resume Next
        Set wks = Worksheets(Cellule.Value)
        If wks Is Nothing Then
            MsgBox "Impossible d'accéder à la feuille " & Cellule.Value & "!"
            Err.Clear
            Exit Sub
        End If
        On Error GoTo 0
        Set rngDest = wks.UsedRange
        If rngDest.Cells.Count > 1 Then
            Set rngDest = wks.Cells(wks.UsedRange.Rows.Count + 1, 1)
        End If
        Application.ScreenUpdating = False
        Cellule.EntireRow.Copy
        wks.Paste Destination:=rngDest
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
End Sub

Il permet de mettre à jour la feuille de destination même si la ligne d'entrée est copiée et non entrée à la main...

Il faut noter que, si un jour tu insères une colonne dans le tableau d'entrée, le code ne fonctionnera plus. En effet, il suppose que la colonne d'intérêt est la numéro 11 (K). La procédure pourrait être plus robuste si ton tableau d'entrée comporte des entêtes de colonne. Ainsi, la procédure pourrait chercher le nom de la colonne d'entrée plutôt que de se fier à son numéro de colonne...