Petit souci avec des cellules fusionnées.

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
 

vbacrumble

XLDnaute Accro
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 ;)
 

kioups

XLDnaute Occasionnel
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 !
 

Cousinhub

XLDnaute Barbatruc
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é
 

kioups

XLDnaute Occasionnel
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...
 

Discussions similaires

Réponses
17
Affichages
836

Statistiques des forums

Discussions
312 211
Messages
2 086 299
Membres
103 173
dernier inscrit
Cerba95