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 :
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
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