Fusionner par 3 toutes les cellules de ligne 4 en partant de B4 à DN

[Broch002]

Bonjour, Le forum.

je cherche, au lancement d'une macro, à fusionner les cellules de la ligne 4 de B4 à DN4 par 4 cellules.
c'est pour une mise en page d'un Tableau. Ces cellule fusionnée me servent de cellule de Titre au dessus des 4 colonnes, A-1, A Cumul, A-1 trimestre, A trimestre .

Merci d"avance.

Broch002

 

[Gareth]

Re : Fusionner par 3 toutes les cellules de ligne 4 en partant de B4 à DN

Bonjour,

Tu peux essayer ceci :

Sub Test()
Sheets(1).Rows(4).UnMerge
For i = 2 To 118 Step 4
    Sheets(1).Cells(4, i).Resize(1, 4).Merge
Next
End Sub

 

[Broch002]

Re : Fusionner par 3 toutes les cellules de ligne 4 en partant de B4 à DN

Re-bonjour,

Je joins un classeur test pour être plus explicite.

En B4 commence les cellules fusionnées, n'y arrivant pas par macro, je l'ai fait à la mano:

Je cherche a remplir ces cellules avec le nom des clients par cette macro qui fonctionne mal (manque des clients):

Sub DETAIL_CLIENT()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Réalisation").Select

With Sheets("Réalisation")
titres = Array("Clients25", "Client1", "Client2", "Client3", "Client4", "Client5", "Client6", "Client7", "Client8", _
"Client9")
End With
For N = LBound(titres) To UBound(titres)
Sheets("Réalisation").Cells(4, 2 + N) = titres(N)
Next N


End Sub

Je cherche également à remplir les cellules des références client par les données des feuilles A, A-1 et A-1 Total.
Actuellement j'utilise une méthode archaïque, qui dans ce cas en plus ne fonctionne pas pour le trie trimestrielle D6 :
Sub référence_Client1()

Application.ScreenUpdating = False
Sheets("Réalisation").Select
Worksheets("A-1").AutoFilterMode = False
With Worksheets("A-1 TOTAL")
If Not .AutoFilterMode Then .Range("A11").AutoFilter
End With
Sheets("A-1 Total").Select
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=1, Criteria1:=Array( _
"Client 1"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=2, Criteria1:=Array( _
"Référence1"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("B6").FormulaR1C1 = "='A-1 Total'!R[-5]C[4]"
Range("B6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Réalisation").Select

Select Case Range("A2").Value
Case "janvier"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 01", "2012 02", "2012 03"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "février"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 01", "2012 02", "2012 03"), Operator:=xlFilterValues
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "mars"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 01", "2012 02", "2012 03"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "avril"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 04", "2012 05", "2012 06"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "mai"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 04", "2012 05", "2012 06"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "juin"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 04", "2012 05", "2012 06"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "juillet"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 07", "2012 08", "2012 09"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "août"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 07", "2012 08", "2012 09"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "septembre"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 07", "2012 08", "2012 09"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "octobre"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 10", "2012 11", "2012 12"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "novembre"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 10", "2012 11", "2012 12"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[1]"

Case "décembre"
Sheets("A-1 Total").Range("$A$1:$D$50000").AutoFilter Field:=4, Criteria1:=Array("2012 10", "2012 11", "2012 12"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("E6").FormulaR1C1 = "='A-1 Total'!R[-5]C[0]"

End Select

Range("E6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Réalisation").Activate
Sheets("A-1").Select
With Worksheets("A-1")
If Not .AutoFilterMode Then .Range("A11").AutoFilter
End With
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=1, Criteria1:=Array( _
"Client 1"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=2, Criteria1:=Array( _
"Référence1"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("C6").FormulaR1C1 = "='A-1'!R[-5]C[3]"
Range("C6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Réalisation").Activate

Sheets("A").Select
With Worksheets("A")
If Not .AutoFilterMode Then .Range("A11").AutoFilter
End With
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=1, Criteria1:=Array( _
"Client 1"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$D$50000").AutoFilter Field:=2, Criteria1:=Array( _
"Référence1"), Operator:=xlFilterValues
Sheets("Réalisation").Select
Range("D6").FormulaR1C1 = "='A'!R[-5]C[2]"
Range("D6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Réalisation").Activate

End Sub

Il faut que je face cette macro par par clients et par référence.

Je me noie.

Merci de votre aide.

Broch002

 

[Broch002]

Re : Fusionner par 4 toutes les cellules de ligne 4 en partant de B4 à AT

Bonjour,

Je continu à chercher, si quelqu'un à une idée?

Merci d'avance.

Broch002.

 

[Gareth]

Re : Fusionner par 3 toutes les cellules de ligne 4 en partant de B4 à DN

Bonjour,

Voila deja pour remplir les cellules fusionnées

Sub DETAIL_CLIENT()
Application.ScreenUpdating = False
titres = Array("Clients25", "Client1", "Client2", "Client3", "Client4", "Client5", "Client6", "Client7", "Client8", "Client9")
With Sheets("Réalisation")
For N = LBound(titres) To UBound(titres)
    .Cells(4, (N * 4) + 2).Value = titres(N)
Next N
End With
Application.ScreenUpdating = True
End Sub

Pour l'autre macro, il faudrait que tu fournisses les onglets "A-1" et "A-1 TOTAL"