Creation de lignes en fonction des colonnes remplies

**janakka-horus** · 21/12/2013, 23h51

Bonjour,

Je voudrai savoir s'il est possible de créer des lignes numérotées dans une feuilles en fonction du nombre de colonnes remplies d'un tableau situé dans une autre feuille.

Je m'explique.
Dans une feuille "Feuil1" j'ai un tableau aven un certain nombre de lignes.
Une Ligne représente un établissement pour un relevé.

Mon souhait serai par exemple :
concernant l’établissement E006

Si les 5 colonnes TTC - FT - FN -AT - AN sont toutes remplies

Alors sur le tableau de la "Feuil2" il doit être crée 5 lignes concernant E006

concernant l’établissement E007

Si seulement 3 colonnes TTC -AT - AN sont toutes remplies

Alors sur le tableau de la "Feuil2" il doit être crée 3 lignes concernant E007

Etc...

Voir l'exemple.

Merci pour votre aide.

Si je n'ai pas été assez explicite merci de me le signaler

**nibledispo** · 22/12/2013, 04h22

Bonjour,

le code ci-dessous fonctionne.
Attention : il comptabilise comme renseignées les colonnes éloignées de la feuille 1. il faudra mettre ces colonnes sur une autre feuille.

Par ailleurs, il t'appartient de savoir si tu veux balayer toutes les lignes (boucle for next) ou n'insérer que les lignes correspondant à une entrée nouvelle dans la feuille 1.

Enfin, les lignes crées devront être renseignées (automatiquement ou manuellement) pour que le prochain insert se fasse au delà de ces lignes.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub inserer_lignes()
For Each cel In Sheets("feuil1").Columns(1)
    Nligne = cel.Row + 1 'pour ne pas tenir compte de l'entete
    nbcel = WorksheetFunction.CountA(Sheets("feuil1").Rows(Nligne))
    With Sheets("feuil2")
         preligvide = .[a1].End(xlDown).Row + 1
         .Rows(preligvide).Resize(nbcel).Insert Shift:=xlDown 
    End With
Next
End Sub

Cordialement

**janakka-horus** · 22/12/2013, 12h48

Donc si j'ai bien compris il est possible de recopier automatiquement les info contenus dans "Feuil1" dans les cellules correspondante de la "Feuil2".
Si c'est possible je suis preneur. Mais je ne sais pas comment faire car je dois l'avouer je ny connais rien en VBA

Et effectivement le code doit balayer le tableau de la Feuil1 et les données doivent être présentées comme dans l'exemple.

Car si cela marche cela va me faire gagner beaucoup de temps car j'ai 72 tableau comme celui de la Feuil1 à traiter
Merci pour ton aide

Les autres colonnes ne figurant pas dans le ableu sont en fait a supprimer, j'ai juste oublier de le faire.

Merci

**Marc-L** · 22/12/2013, 13h01

Bonjour,

sans une présentation claire et exhaustive, voici quand même un exemple afin de recopier les codes ETS de la "Feuil1"
autant de fois qu'il y a de montants saisis vers la "Feuil2" en colonne F (code à insérer dans le module de la "Feuil1") :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo()
    CS = Me.[A1].CurrentRegion.Columns(1).Value
    ReDim AR$(1 To Application.Count(Me.Range("C2:G" & UBound(CS))), 1 To 1)
 
    For R& = 2 To UBound(CS)
        For C& = 1 To Application.Count(Me.Cells(R, 3).Resize(, 5))
                  L& = L& + 1
            AR(L, 1) = CS(R, 1)
        Next
    Next
 
    Feuil3.[F2].Resize(UBound(AR)).Value = AR
    Erase AR, CS
End Sub

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**janakka-horus** · 22/12/2013, 17h48

Ton code est interessant, j'ai donc essayer de rajouter autre chose.
C'est a dire reporter le n°de Relevé a la fois dans la colonne n° pièce et la colonne n° relevé de la feuil1.
Mais je ne suis pas arrive.

Voici mon code modifié

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 Demo()
    CS = Me.[A1].CurrentRegion.Columns(1).Value
    ReDim AR$(1 To Application.Count(Me.Range("C2:G" & UBound(CS))), 1 To 1)
 
    For R& = 2 To UBound(CS)
        For C& = 1 To Application.Count(Me.Cells(R, 3).Resize(, 5))
                  L& = L& + 1
            AR(L, 1) = CS(R, 1)
        Next
    Next
 
    Feuil3.[F2].Resize(UBound(AR)).Value = AR
    Erase AR, CS
End Sub
 
Sub Demo2()
    CS = Me.[B1].CurrentRegion.Columns(1).Value
    ReDim AR$(1 To Application.Count(Me.Range("C2:G" & UBound(CS))), 1 To 1)
 
    For R& = 2 To UBound(CS)
        For C& = 1 To Application.Count(Me.Cells(R, 3).Resize(, 5))
                  L& = L& + 1
            AR(L, 1) = CS(R, 1)
        Next
    Next
 
    Feuil3.[A2].Resize(UBound(AR)).Value = AR
    Erase AR, CS
End Sub

**Marc-L** · 22/12/2013, 19h51

Envoyé par janakka-horus

C'est a dire reporter le n°de Relevé a la fois dans la colonne n° pièce et la colonne n° relevé de la feuil1.

Reporter la colonne ETS de la "Feuil1" vers la colonne F de la "Feuil2"
et la colonne RELEVE de la "Feuil1" vers les colonnes A & J de la "Feuil2"
et ce, autant de fois qu'il y a de montants saisis par ligne (code à insérer dans le module de la "Feuil1") :

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
Sub Demo()
    With Me.[A1].CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            ER = .Columns("A:B").Value
            MS = .Columns("C:G").Value
        End With
    End With
 
    With Application
        N& = .Count(MS)
        ReDim ETS$(1 To N, 1 To 1)
        ReDim REL$(1 To N, 1 To 1)
 
        For R& = 1 To UBound(ER)
            For C& = 1 To .Count(.Index(MS, R))
                       L& = L& + 1
                ETS(L, 1) = ER(R, 1)
                REL(L, 1) = ER(R, 2)
            Next
        Next
                    .ScreenUpdating = False
        Feuil3.[A2].Resize(N).Value = REL
        Feuil3.[F2].Resize(N).Value = ETS
        Feuil3.[J2].Resize(N).Value = REL
                    .ScreenUpdating = True
        Erase ER, ETS, MS, REL
    End With
End Sub

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

__________________________________________________________________________________________
Quelle époque terrible que celle où des idiots dirigent des aveugles. (Shakespeare)

**janakka-horus** · 22/12/2013, 23h02

Merci Super. Mon but maintenant c'est de recopier les données des colonnes TTC, FT, FN, AT et AN en fonction des Ets et n° Relevé.

comme dans l'exemple que j'ai saisie manuellement.

Est il possible de le faire par VBA ou par formule?

**Marc-L** · 23/12/2013, 01h03

Oui c'est possible …

Mais comme c'était le but dès le départ, cela aurait été préférable de l'exposer clairement à l'origine de cette discussion
car à chaque nouvelle demande le code peut être remis intégralement en question !

**janakka-horus** · 23/12/2013, 08h33

En fait je voulais essyer de le faire par moi meme, c'est pour cela.
Mais bon le resultat n'est pas fameux car j'avais penser a utiliser la fonction recherche v.

Mais cela ne marche pas.

J'ai beaucoup de progres a faire.
Pourrais tu m'aider une dernière fois.

Merci

**Marc-L** · 23/12/2013, 16h05

Peu importe le module pour ce code :

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
Sub Demo()
                            CH = [{4010000,6262000,6262000,6261000,6261000}]
                            TX = [{"","D1960EPM","D0000DT","D1960EPM","D0000DT"}]
    Application.ScreenUpdating = False
                            AR = Feuil2.[A1].CurrentRegion
                            L& = 1
    With Feuil3
        For R& = 2 To UBound(AR)
            For C& = 3 To 7
                If AR(R, C) > "" Then
                                               L = L + 1
                              .Cells(L, 1).Value = AR(R, 2)
                              .Cells(L, 6).Value = AR(R, 1)
                              .Cells(L, 8).Value = CH(C - 2)
                             .Cells(L, 10).Value = AR(R, 2)
                             .Cells(L, 14).Value = TX(C - 2)
                   .Cells(L, 17 - (C = 3)).Value = AR(R, C)
                End If
            Next
        Next
 
        .Activate
    End With
 
    Application.ScreenUpdating = True
    Erase AR, CH, TX
End Sub

_______________

____________________________________

______________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

__________________________________________________________________________________________
Pluie en Novembre, Noël en Décembre !

**janakka-horus** · 24/12/2013, 00h32

Merci super

c'est absolument ce que je voulais.

Mais avant de mettre résolu. (Désolé je fais mon gros bourrin de base

)
Je voudrai savoir si je veux rajouter un commentaire sur les 5 première lignes et décaler les titres sur la 6 eme ligne que dois je modifier dans le code pour que cela me recopie les donnée qu'à partir de la 7 ligne du tableau.

Encore une fois Merci pour le cadeaux