Petit souci avec des cellules fusionnées.

  • Initiateur de la discussion Initiateur de la discussion kioups
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

kioups

XLDnaute Occasionnel
Bonsoir à tous !

J'ai une macro qui permet de copier les données d'un classeur dans un autre. Ca n'est pas moi qui est fait cette macro (un tout petit peu...), mais vbacrumble y a beaucoup contribué !

Donc, j'ai des données que je souhaite copier dans des cellules fusionnées. Je sais, c'est pas l'idéal, mais bon, mon classeur a tout de suite plus d'allure.

J'ai modifié ma macro pour défusionner les cellules, faire ma copie puis les refusionner. Mais j'ai un problème d'objet non défini...

Voici ma macro :

Code:
Sub Importation_Journée(Nom$)
Dim WBK As Workbook, ws As Worksheet
Dim NumeroJournee&, JoueursJournee&, NbreJoueursTotal&, ColonneJoueur&
Dim i%, j%, k%, NJ%, N1%, NN%, N2%
Dim NomJoueur$, S$

Set WBK = ThisWorkbook: Set ws = ActiveSheet
' Rajout des deux calculs
S = ws.Cells(3, 1).Text
NumeroJournee = 1 * Left(Split(Split(S, ":")(1))(1), (IIf(Len(Split(Split(S, ":")(1))(1)) = 5, 2, 1)))
JoueursJournee = 1 * Left(ws.Cells(6, 1).Text, 2)
' Suppression des bordures
ws.Cells.Borders.LineStyle = xlNone
' Sélection des matchs de la journée
[COLOR="RoyalBlue"]ws.Range("B9:C18").Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), 2)[/COLOR]
'jusqu'ici OK
'Sélection d'un joueur
For i = 1 To JoueursJournee
        NomJoueur = ws.Cells(8, 8 + 4 * (i - 1))
'    ' Savoir si le joueur existe déjà ou pas
NbreJoueursTotal = WBK.Worksheets("Feuil1").Range("B1").Value
       k = 1
        Do While k < NbreJoueursTotal + 1
            If WBK.Worksheets("Feuil1").Cells(4, 15 + 3 * (k - 1)).Value = NomJoueur Then
                ColonneJoueur = 15 + 3 * (k - 1)
                Exit Do
            Else
                k = k + 1
            End If
        Loop
'    ' Copie du nom du joueur
    If k = NbreJoueursTotal + 1 Then
    ColonneJoueur = 15 + 3 * NbreJoueursTotal
    [COLOR="Red"]WBK.Sheets("Feuil1").Range(Cells(4, ColonneJoueur), Cells(4, ColonneJoueur + 2)).UnMerge[/COLOR]
    ws.Cells(8, 8 + 4 * (i - 1)).Copy WBK.Sheets("Feuil1").Cells(4, ColonneJoueur)
    [COLOR="Red"]WBK.Sheets("Feuil1").Range(Cells(4, ColonneJoueur), Cells(4, ColonneJoueur + 2)).Merge[/COLOR]
' Fusionnage des cellules
' Copie des votes du joueur
ws.Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur)
    Else
    ws.Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur)
    End If
Next i
End Sub

En rouge, ce sont les deux lignes que j'ai rajoutées. Ca ne fonctionne pas dès la première.

Question bonus : la copie des matchs de la journée (en bleu) s'effectue sans souci, à part que ça enlève mes bordures dans mon tableau. Il y a moyen de ne copier que le texte mais pas la mise en forme ?

Merci d'avance !

Kioups
 
Re : Petit souci avec des cellules fusionnées.

Bonsoir kioups


Tester comme si dessous

Code:
ColonneJoueur = 15 + 3 * NbreJoueursTotal
    WBK.Sheets("Feuil1").Range(WBK.Sheets("Feuil1").Cells(4, ColonneJoueur), WBK.Sheets("Feuil1").Cells(4, ColonneJoueur + 2)).UnMerge
    ws.Cells(8, 8 + 4 * (i - 1)).Copy WBK.Sheets("Feuil1").Cells(4, ColonneJoueur)
    WBK.Sheets("Feuil1").Range(WBK.Sheets("Feuil1").Cells(4, ColonneJoueur), WBK.Sheets("Feuil1").Cells(4, ColonneJoueur + 2)).Merge

PS: Last but not least 😉
 
Re : Petit souci avec des cellules fusionnées.

Merci beaucoup, c'est ok !

Par contre, j'ai encore le souci que je t'ai dit par MP, à savoir que ça ne met que le dernier joueur de ma liste.
Si je refais l'opération sur la même journée, ça me rajoute, ensuite, l'avant-dernier joueur...

Et ainsi de suite...

M'enfin, là, je vais m'arrêter pour aujourd'hui... Je m'y remets mercredi soir !

Merci encore !
 
Re : Petit souci avec des cellules fusionnées.

Bonsoir,

A titre d'info, ce code copie une zone fusionnée dans une cellule (qui sera également fusionnée......)

Code:
Range("A1").MergeArea.Copy Sheets("Feuil2").Range("A1")

bonne soiré
 
Re : Petit souci avec des cellules fusionnées.

Merci bhbh.

Le souci, c'est que mes zones fusionnées du classeur d'origine des données ne sont pas de la même taille que celles où j'effectue mes modifs.

Enfin, là, ça a l'air de fonctionner pas trop mal...
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
177
Réponses
5
Affichages
562
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
Réponses
17
Affichages
2 K
Retour