Discussion :

[franckimmo]

Bonjour à tous,

Mon problème est que dans mon fichier exell, j'ai rempli les infos pour le client, puis tous les mois je créer deux colonnes une pour le montant versé par le client et l'autre par le numéro d'extrait de compte référencent le paiement du client. Le problème c'est que dans une année et bien je crée 24 colonnes supplémentaire.
J'aimerai transférer toutes ces colonnes en lignes afin de pouvoir les transférer dans access.
La colonne C indique le ID du client
Ex de mon souhait:
1er Ligne Colonne A à I et colonne J + colonne K
2ème Ligne Colonne A à I et Colonne L + colonne M
Etc....
Je pense qu'aucune solutio est envisageable, mais peut être que je me trompe
Merci bien
Ci-joint le fichier exell

[Fvandermeulen]

Bonjour,
Voici un petit code exemple pour te mettre sur la piste...bon amusement

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 PrepaAccess()
 
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long
 
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row 'détermine la derière ligne pour la sélection à copier
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column 'détermine le nombre de colonne
 
For i = 11 To NbCol Step 2 'fait une boucle pour balayer les colonnes
    derLigne = Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1 'défini la dernière ligne de la colonne i pour le collage
    Range(Cells(2, 1), Cells(DerLtabl, 8)).Copy Destination:=Cells(derLigne, 1)
    Range(Cells(2, i), Cells(DerLtabl, i + 1)).Copy Destination:=Cells(derLigne, 9)
Next i
 
End Sub

A+

[franckimmo]

Bonjour Fvandermeulen,

Merci pour ton aide, dans l'exemple je souhaiterai plutôt créer une autre feuille. La colonne B étant L'Id de chaque client et la colonne D le nom de chaque client.
La colonne I le montant versé d'un certain mois, la colonne J le numéro de l'extrait de paiement et la colonne K le mois et l'année du versement.
La colonne L le montant versé du mois suivant, la colonne M le numéro de l'extrait de paiement du mois suivant et la colonne N le mois et l'année du versement du mois suivant.
En règle général l'idéal serait :
Ligne1 B+D+I+J+K
Ligne2 B+D+L+M+N
Merci bien

[Fvandermeulen]

Salut,
L'idée c'était que tu cherche un peu
Tu pouvais copier ta feuille faire tourner le code et ensuite faire un tri sur le numéro ID, je pense que tu aurais le même résultat, mais pour le sport, voici le code adapté avec une boucle suplémentaire pour les lignes.
J'ai ajouter une feuille manuellement (feuille nommée Cible)

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
Sub PrepaAcces2()
 
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long, j As Long
 
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
 
For j = 2 To DerLtabl
    For i = 9 To NbCol Step 2
        derLigne = Sheets("Cible").Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1
        Range(Cells(j, 1), Cells(j, 8)).Copy Destination:=Sheets("Cible").Cells(derLigne, 1)
        Range(Cells(j, i), Cells(j, i + 1)).Copy Destination:=Sheets("Cible").Cells(derLigne, 9)
    Next i
Next j
 
End Sub

A+

[franckimmo]

Bonjour Fvandermeulen,

J'ai un peu changé ton code, mais le premier problème je n'ai plus le titre. Le deuxième c'est si les colonne I ou J vide ou les deux alors ne pas copier la ligne est-ce possible cela.

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
   Sub PrepaAcces2()
 
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long, j As Long
 
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
 
For j = 2 To DerLtabl
    For i = 10 To NbCol Step 3
        derLigne = Sheets("Cible").Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1
        Range(Cells(j, 1), Cells(j, 8)).Copy Destination:=Sheets("Cible").Cells(derLigne, 1)
        Range(Cells(j, i), Cells(j, i + 1)).Copy Destination:=Sheets("Cible").Cells(derLigne, 9)
    Next i
Next j
 
End Sub

La seule chose que j'ai trouvé pour la création des libellés c'est ceux-ci :

Code :

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

1
2
3
4
5
Range("A1:N1").Select
    Selection.Copy
    Sheets("Cible").Select
    Rows("1:1").Select
    ActiveSheet.Paste

Mais franchement j'aime pas trop, cela fait pas pro.

Merci bien

[franckimmo]

Bonjour à tous,

J'aimerai mettre trois colonnes (i,j et k) en ligne. Avec le code ci-dessous je n'arrive qu'a en mettre deux (i et j) comment faire pour mettre la colonne k en ligne? Je n'arrive pas à trouver la syntaxe.
Le deuxième problème que je rencontre c'est que tous le tableau se met en gras et non que la première ligne (a1:k1)
Si quelqu'un a une idée ce serait sympa.
Merci à vous

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
55
56
57
58
59
60
61
62
63
64
Sub PrepaAcces2()
 
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long, j As Long
 
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row 'détermine la derière ligne pour la sélection à copier
 
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column 'détermine le nombre de colonne
 
 
 
For j = 2 To DerLtabl
    For i = 10 To NbCol Step 3 'fait une boucle pour balayer les colonnes
 
             'défini la dernière ligne de la colonne i pour le collage
        derLigne = Sheets("Cible").Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1
         Range(Cells(j, 1), Cells(j, 8)).Copy Destination:=Sheets("Cible").Cells(derLigne, 1)
        Range(Cells(j, i), Cells(j, i + 1)).Copy Destination:=Sheets("Cible").Cells(derLigne, 9)
    Next i
Next j
 
 
 Sheets("Cible").Select
With Worksheets("Cible")
    .Cells(1, 1).Value = "Studio"
    .Cells(1, 2).Value = "Code Client"
    .Cells(1, 3).Value = "Agence"
    .Cells(1, 4).Value = "Nom"
    .Cells(1, 5).Value = "Caution"
    .Cells(1, 6).Value = "Date entrée"
    .Cells(1, 7).Value = "Date Sortie"
    .Cells(1, 8).Value = "Loyer"
    .Cells(1, 9).Value = "Extrait"
    .Cells(1, 10).Value = "Mois"
    End With
 
    Selection.Font.Bold = True
    Range("I1:j1").Select
    With Selection.Font
        .Color = -11489280
        .TintAndShade = 0
    End With
 
    Selection.Font.Bold = True
    Range("A1:H1").Select
    Selection.Font.Bold = True
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = -1
 
    End With
 
    Range("a1:j1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Franck

Bonjour,
J'ai trouvé les solution aux problèmes ci-dessus, mais je souhaiterai pouvoir éviter de rajouter les lignes quand la colonne "j" est vide.
Voici tout mon 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
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
55
56
57
58
59
60
61
62
63
64
65
66
Sub PrepaAcces2()
 
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long, j As Long, k As Long
 
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row 'détermine la derière ligne pour la sélection à copier
 
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column 'détermine le nombre de colonne
 
 
 
For j = 2 To DerLtabl
    For i = 10 To NbCol Step 3 'fait une boucle pour balayer les colonnes
 
             'défini la dernière ligne de la colonne i pour le collage
        derLigne = Sheets("Cible").Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1
         Range(Cells(j, 1), Cells(j, 9)).Copy Destination:=Sheets("Cible").Cells(derLigne, 1)
        Range(Cells(j, i), Cells(j, i + 1)).Copy Destination:=Sheets("Cible").Cells(derLigne, 10)
    Next i
Next j
 
 
 Sheets("Cible").Select
With Worksheets("Cible")
    .Cells(1, 1).Value = "Studio"
    .Cells(1, 2).Value = "Code Client"
    .Cells(1, 3).Value = "Agence"
    .Cells(1, 4).Value = "Nom"
    .Cells(1, 5).Value = "Caution"
    .Cells(1, 6).Value = "Date entrée"
    .Cells(1, 7).Value = "Date Sortie"
    .Cells(1, 8).Value = "Loyer"
    .Cells(1, 9).Value = "Montant"
    .Cells(1, 10).Value = "Extrait"
    .Cells(1, 11).Value = "Mois"
 
    End With
 
    Selection.Font.Bold = True
    Range("I1:j1").Select
    With Selection.Font
        .Color = -11489280
        .TintAndShade = 0
    End With
 
    Selection.Font.Bold = True
    Range("A1:H1").Select
    Selection.Font.Bold = True
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = -1
 
    End With
 
    Range("a1:k1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Bonne soirée à tous
A+