Fusionner deux macros

[Claudius91]

Bonjour,

Modifiant mes dossiers au fur et à mesure de leurs utilisations, je voudrais fusionner 2 macros si c'est possible.

Sinon modifier la macro 2 pour que le nombre de lignes transposer correspondent au mois de la feuille (exemple 28 pour février)

Je m'explique : 

la macro N°1  sélectionne dans une colonne le nombre de cellules en fonction du nombre d'heure du mois de l'onglet de la feuille

(745 pour 31 jours - 721 pour 30 jours - 613 pour 28 jours)

La macro 2 selectionne la colonne de la macro 1 pour la transposer en lignes de 24 colonnes.

Sub Macro1()
'
' Macro1Macro
' color Heure
'

' 
   Dim jours As Long
     Select Case ActiveSheet.Name
       Case "Janv", "Mars", "Mai", "juillet", "Aout", "Oct", "Dec": jours = 745
       Case "Avril", "Juin", "Sept", "Nov": jours = 721
       Case "Fev": jours = 673
     End Select
     Dim plage As Range
    Set plage = ActiveSheet.Range("AL2:AL" & (2 + jours - 2))
    plage.Select
      
End Sub

 

Sub Macro2()

'Macro 2Macro
Transpose AL vers L
lig = 3
For bcl = 0 To 30
Range("AL" & 2 + (24 * bcl) & ":AL" & (24 * (bcl + 1)) + 1).Copy
Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
lig = lig + 1
Next bcl
End Sub

Je pense que la modif doit se situer au niveau de la ligne 

For bcl = 0 to 30

 

Merci d'avance pour vos réponses

[Longaripa]

Bonjour 

Pour fusionner les 2 macros, il suffit d'insérer  la macro2 à la fin de la macro1.

Ou mettre Call macro2 à la fin de macro1 

[Claudius91]

Bonjour Longaripa

En fait je me suis mal expliqué.

Ce que je voulais, c''est que cette fusion permette lors de l'exécution de la transposition respecter le nombre de lignes selon le mois (31, 30 ou 28).

Car comme il y a somme de chaque colonne sous le dernière ligne, elle est effacée pour les mois de 30 et 28 jours.

Ce qu'il faudrait modifier, la ligne "For bcl = 0 to 30" peut être, je ne sais pas 

 

 

[Longaripa]

Re 

J'avoue ne pas comprendre ce qu'il faut faire.
Au début, il y avait des jours, maintenant des heures ...

Et transformer des colonnes en lignes ..

Non, je n'ai pas d'idées ...

[Claudius91]

Bonjour Logaripa,

C'est vrai, un peu brouillon.

Je joihs un fichier pour éclaircir mes propos.

Les colonnes AL et AM sont des relevés par heures pour le mois d'avril.

Grace à la macro si dessous, ces colonnes de chiffres sont transposées par lignes, heures par heures, jours par jours.

Sub Macro6() ' 'Macro 6Macro Transpose AL vers L3, AM vers L38 - 31 jours       lig = 3     For bcl = 0 To 30         Range("AL" & 2 + (24 * bcl) & ":AL" & (24 * (bcl + 1)) + 1).Copy         Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True         lig = lig + 1         Next bcl     lig = 38     For bcl = 0 To 30         Range("AM" & 2 + (24 * bcl) & ":AM" & (24 * (bcl + 1)) + 1).Copy         Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True         lig = lig + 1         Next bcl End Sub   Tableaux  L3:AI32 et L38:AI67 Le problème, dans le cas des mois de 30 jours et le mois de février, toutes écritures sous la dernière ligne des tableaux se trouvent effacées sauf si je modifie les lignes soulignées pour les mois à 30 jours et pour le mois de février. Ce que je voudrais c'est une macro unique pour tous les mois de l'année. C'est possible ?                                                              Next bcl     lig = 38     For bcl = 0 To 30         Range("AM" & 2 + (24 * bcl) & ":AM" & (24 * (bcl + 1)) + 1).Copy         Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True         lig = lig + 1         Next bcl End Sub
'

Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
lig = lig + 1
Next bcl
End Sub

 

Classeur1.xlsx

[Longaripa]

Bonjour 

Essayez ceci : 

Sub macro6()
'
'Macro 6Macro
'Transpose AL vers L3, AM vers L38 - 31 jours
 
 Select Case ActiveSheet.Name
       Case "Janv", "Mars", "Mai", "juillet", "Aout", "Oct", "Dec": jours = 31
       Case "Avril", "Juin", "Sept", "Nov": jours = 30
       Case "Fev": jours = 28
     End Select
 
    lig = 3
    For bcl = 0 To jours - 1
        Range("AL" & 2 + (24 * bcl) & ":AL" & (24 * (bcl + 1)) + 1).Copy
        Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        lig = lig + 1
        Next bcl
    lig = 38
    For bcl = 0 To jours - 1
        Range("AM" & 2 + (24 * bcl) & ":AM" & (24 * (bcl + 1)) + 1).Copy
        Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        lig = lig + 1
        Next bcl
End Sub

 

[Claudius91]

Il y a 2 heures, Longaripa a dit :

Bonjour 

Essayez ceci : 

Sub macro6()
'
'Macro 6Macro
'Transpose AL vers L3, AM vers L38 - 31 jours
 
 Select Case ActiveSheet.Name
       Case "Janv", "Mars", "Mai", "juillet", "Aout", "Oct", "Dec": jours = 31
       Case "Avril", "Juin", "Sept", "Nov": jours = 30
       Case "Fev": jours = 28
     End Select
 
    lig = 3
    For bcl = 0 To jours - 1
        Range("AL" & 2 + (24 * bcl) & ":AL" & (24 * (bcl + 1)) + 1).Copy
        Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        lig = lig + 1
        Next bcl
    lig = 38
    For bcl = 0 To jours - 1
        Range("AM" & 2 + (24 * bcl) & ":AM" & (24 * (bcl + 1)) + 1).Copy
        Range("L" & lig).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        lig = lig + 1
        Next bcl
End Sub

 

 

[Claudius91]

Super

Merci beaucoup

exactement ce que je voulais