Fusionner des cellules selon plusieurs variables
Bonjour le forum,
j'essaie de faire fonctionner un code en vain ...
J'aimerai faire fusionner la ligne 1 (qui correspond aux titres) chaque mois avec plus de colonnes et sur plusieurs feuilles.
Je pense que l'explication que je donne n'est pas très claire. Avec le code ce sera plus simple à comprendre.
Sub fusion_titr()
'
Dim Lignes
Dim Colonne As Integer
Dim NbColonnes As Integer
Dim Depart As String
LesFeuilles = Array("Résumé", "Aéro D", "FAL D", "OP - Approvisionnement", "OP- MOD", "OP - Composants", "Détail appro")
NbColonnes = InputBox("Nombre de nouveaux produits?")
Depart = InputBox("Quel est la dernière colonne rentrée ?")
Application.ScreenUpdating = False
Colonne = Columns(Depart).Column ' Noter ici le nom de la dernière colonne
With Sheets(LesFeuilles)
' Fusionner titre
.Range(.Cells(1, 1), .Cells(1, Colonne + NbColonnes + 2)).Merge
End With
End Sub
N'hésitez pas à demander pour plus d'explications,
Merci par avance
Bonjour
Pas sur d'avoir tout saisi
Sub fusion_titr()
Dim Colonne As Integer
Dim NbColonnes As Integer, I As Integer
Dim Depart As Range
Dim LesFeuilles
LesFeuilles = Array("Résumé", "Aéro D", "FAL D", "OP - Approvisionnement", "OP- MOD", "OP - Composants", "Détail appro")
NbColonnes = InputBox("Nombre de nouveaux produits?")
Set Depart = Application.InputBox("Quel est la dernière colonne rentrée ?", "Cliquer sur la colonne", Type:=8)
Application.ScreenUpdating = False
Colonne = Depart.Column ' Noter ici le nom de la dernière colonne
For I = 0 To UBound(LesFeuilles)
'With Sheets(lesfeuilles)
With Sheets(LesFeuilles(I))
' Fusionner titre
.Range(.Cells(1, 1), .Cells(1, Colonne + NbColonnes + 2)).Merge
End With
Next I
End Sub
Si pas ça
Ah super ça marche. Par contre, je suis obligée de taper la cellule précise,par exemple "AR1". Et je voudrai n'avoir que le nom de la colonne à taper "AR" en sachant que la fusion doit se faire automatiquement et toujours sur la ligne 1.
J'explique pourquoi , je veux l'intégrer à une macro ou je rentre déjà le nom de la colonne donc j'aimerai utiliser le même inputbox.
Bonjour
Camille65 a écrit :je suis obligée de taper la cellule précise
Non tu cliques sur la colonne, et automatiquement la cellule tapée est inscrite dans la zone de saisie,
Tu peux cliquer n'importe où dans la colonne
Oui oui je pense avoir saisi, mais il faudrait que la boîte de dialogue n'enregistre que le nom de colonne et non la ligne aussi
Voici le code entier que j'ai fait et qui ne fonctionne plus avec l'intégration de tes codes...
Sub MAJ_Tableaux()
Dim Lignes
Dim LesFeuilles
Dim I As Integer, Colonne As Integer
Dim NbColonnes As Integer
Dim Depart As Range
Dim Suppcol As String
Lignes = Array(27, 36, 61, 73, 27, 38, 37, 44, 37, 44, 39, 45, 20, 41)
LesFeuilles = Array("Résumé", "Aéro D", "FAL D", "OP - Approvisionnement", "OP- MOD", "OP - Composants", "Détail appro")
NbColonnes = InputBox("Nombre de produits?")
Set Depart = Application.InputBox("Quel est la dernière colonne rentrée ?", "Cliquer sur la colonne", Type:=8)
Suppcol = InputBox("Quel est la colonne vide précédant le dernier mois rentré?")
Application.ScreenUpdating = False
Colonne = Columns(Depart).Column ' Noter ici le nom de la colonne de départ
For I = 0 To UBound(LesFeuilles)
With Sheets(LesFeuilles(I))
.Range(.Cells(Lignes(I * 2), Colonne), .Cells(Lignes((I * 2) + 1), Colonne)).AutoFill _
Destination:=.Range(.Cells(Lignes(I * 2), Colonne), .Cells(Lignes((I * 2) + 1), Colonne)).Resize(, NbColonnes + 3), Type:=xlFillDefault
' La Moyenne
.Range(.Cells(Lignes(I * 2), Colonne - 1), .Cells(Lignes((I * 2) + 1), Colonne - 1)).Copy
.Range(.Cells(Lignes(I * 2), Colonne + NbColonnes + 1), .Cells(Lignes((I * 2) + 1), Colonne + NbColonnes + 1)).PasteSpecial Paste:=xlPasteFormats
' Les produits
.Range(.Cells(Lignes(I * 2), Colonne - 2), .Cells(Lignes((I * 2) + 1), Colonne - 2)).Copy
.Range(.Cells(Lignes(I * 2), Colonne + 1), .Cells(Lignes((I * 2) + 1), Colonne + 1)).Resize(, NbColonnes).PasteSpecial Paste:=xlPasteFormats
' Insertion cellule vide et de sa taille
.Range(.Cells(Lignes(I * 2), 5), .Cells(Lignes((I * 2) + 1), 5)).Copy
.Range(.Cells(Lignes(I * 2), Colonne + 1), .Cells(Lignes((I * 2) + 1), Colonne + 1)).Insert
.Range(.Cells(Lignes(I * 2), Colonne), .Cells(Lignes((I * 2) + 1), Colonne)).ColumnWidth = 0.45
' Supprimer l'ancienne colonne vide
.Range(.Cells(Lignes(I * 2), Suppcol), .Cells(Lignes((I * 2) + 1), Suppcol)).Delete
.Range(.Cells(Lignes(I * 2), Suppcol), .Cells(Lignes((I * 2) + 1), Suppcol)).Columns.AutoFit
' Fusionner titre
.Range(.Cells(1, 1), .Cells(1, Colonne + NbColonnes + 2)).Merge
End With
Next I
End Sub
Bonjour
Cette partie a été mal recopiée
'Colonne = Columns(Depart).Column ' Noter ici le nom de la colonne de départ
Colonne = Depart.Column ' Noter ici le nom de la colonne de départ
Mais sans fichier
Oups PARDON... je n'avais pas vu ce changement ...
C'est PARFAIT