Copie et transposer données
salut a tous , j ai besoin de votre aide pour automatiser un fichier.
- créer feuilles a partir de la colonne A feuille Gamedata.
- copier - coller données transposée dans chaque feuille concernée .
ci-joint un fichier bien détaillé.
merci de votre aide
re-salut a tous,
j'ai trouve la solution mais ça me reste quelque chose a résoudre j ai besoin encore de votre aide.
Quand j ai essaye d ajouter une nouvelle colonne entre C et D , la macro bug. il ya un problème de boucle , mais je suis pas capable de le résoudre dans Private Sub cmdok_Click().
Private Sub cmdok_Click()
Dim x, y, z, temp, result, r_split, seat, myvalues, mycolours
Dim i As Long, k As Long, n As Long, offs As Long
Dim Gamedata As String
With Sheets(frmgame.cmbarea.Text)
Application.ScreenUpdating = 0
.Range("E2:EX300").Clear
With Sheets("Gamedata")
x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 16)
ReDim y(1 To UBound(x))
End With
For i = 1 To UBound(x)
y(i) = x(i, 1) & x(i, 2) & x(i, 3) & "|" & x(i, 4) & "|" & x(i, 5) & "|" & x(i, 15)
Next
If .Range("c2") <> "" Then
z = .Range("c2", .Cells(Rows.Count, "c").End(xlUp)).Resize(, 2)
ReDim result(1 To UBound(z), 1 To 150)
For i = 1 To UBound(z)
If z(i, 2) <> "" Then
Gamedata = Me.cmbgame.Text & Me.cmbstand.Text & Me.cmbarea.Text & "|" & z(i, 2) & "|"
temp = Filter(y, Gamedata, 1)
If UBound(temp) > -1 Then
For n = 0 To UBound(temp)
r_split = Split(temp(n), "|")
offs = CLng(r_split(2))
seat = r_split(3)
k = k + offs + 1
result(i, k) = seat
Next
End If
End If
k = 0
Next
.Range("e2").Resize(UBound(result), UBound(result, 2)) = result
End If
.Range("a1") = frmgame.cmbgame.Text
.Columns("E:EX").ColumnWidth = 4.29
.Columns("B:D").ColumnWidth = 8
'This is the code for colour coding the calendar using the different letters'
With .Range("E2:EX300")
.Replace "P", "RES", xlWhole
.Replace ".", "S", xlWhole
.Replace "04", "C", xlWhole
'colouring
myvalues = Split("A,RES,BS,DS,HP,OB,RV,SV,UV,X,RA,C,S,RR", ",")
mycolours = Array(4, 10, 10, 10, 10, 10, 10, 10, 10, 15, 45, 41, 3, 27)
With Application.ReplaceFormat
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
For i = 0 To UBound(mycolours)
Application.ReplaceFormat.Interior.ColorIndex = mycolours(i)
.Replace what:=myvalues(i), replacement:=myvalues(i), lookat:=xlWhole, searchformat:=False, ReplaceFormat:=True
Next
End With
.Activate
End With
Application.ScreenUpdating = 1
End Submerci
Bonjour
rghanmi a écrit :Quand j ai essaye d ajouter une nouvelle colonne entre C et D , la macro bug
Compliqué à suivre ton code
Essayes de modifier cette partie
x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 16)merci pour votre réponse rapide!
pour etre plus clair j ai essaye d ajouter une colonne entre C et D dans feuille Gamedata. et changer le code comme suit :
x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 17)ca marche pas.
Bonjour
C'est que entre ta 1ère demande et celle ci il y a beaucoup de différences
Et ton code tu devais le documenter un peu pour le comprendre, surtout si tu veux qu'on essaie de résoudre ton problème
A temps perdu je regarderai mais je ne garanti rien
je suis vraiment désolé de ne pas être clair dans ma demande. mais j aimerais bien que tu m aide a résoudre le problème selon mon dernier message. le truc est dans la macro Private Sub cmdok_Click() dans le formulare frmgame.
la macro sert a copier et transposer data de la feuille Gamedata et l insère dans la feuille sélectionnée selon le formulaire .
la macro fonctionne bien mais si j ajoute une colonne entre C et D dans la feuille source Gamedata et dans les feuilles destination la macro marche pas.
je crois qu il ya un probleme de boucle.
j espere que que est clair. merci
Bonjour
Moi je veux bien t'aider mais il faut que tu expliques
rghanmi a écrit :la macro marche pas.
Ne veut rien dire
Elle plante ?
Elle affiche n'importe quoi ?
Elle n'affiche rien ?
Elle arrête le métro (non là je déc...ne)
Détailles bien les opérations que tu fais (je ne connais pas ton programme)
rghanmi a écrit :si j ajoute une colonne entre C et D dans la feuille source Gamedata et dans les feuilles destination
Tu insères une colonne dans la feuille Gamedata et aussi dans les feuilles destination ?
Une colonne vierge ?
Pas à pas tu me dis la démarche à suivre pour arriver au problème
ok ci-joint deux version du programme.
la première est la version originale ( Ca marche bien) : Quand tu ouvres le fichier le formulaire frmmain s'affiche , sélectionnes les deux listes déroulantes, mettre dans la 2eme liste deroulante par exemple 121 et cliques sur OK , la macro va prendre les données qui concernent ta sélection de la feuille Stadium et t amener vers la feuille 121 .
Choisir Select game , frmgame s affiche et choisir dans les 3 listes déroulantes, mettre 121 dans 3eme liste déroulante et cliquer sur l icone ballon. la macro va mettre a jour les données dans la feuille 121 mais a partir de la feuille Gamedata cette-fois ci.
la 2eme version revised ( Ca marche pas) : dans cette version je veux ajouter une colonne entre la colonne C et D dans toutes les feuilles , ca marche pour le formulaire frmmain , mais dans frmgame la macro ne s affiche rien.
merci
Bonjour
Suis vraiment désolé mais je n'arrive pas à suivre (comprendre) ta macro
Toi qui l'a faite tu serais plus à même de comprendre ce qui se passe et à trouver l'erreur
Moi je m'y perd dans les tableaux, surtout le but recherché à partir d'une page pour en arrivé à ton dessin
merci beaucoup.
c'est pas moi qui l a fais mais je suis sur et certain que le problème est quelque part ici :
With Sheets(frmgame.cmbarea.Text)
Application.ScreenUpdating = 0
.Range("E2:EX300").Clear
With Sheets("Gamedata")
x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 16) ' peut être ici
ReDim y(1 To UBound(x))
End With
For i = 1 To UBound(x)
y(i) = x(i, 1) & x(i, 2) & x(i, 3) & "|" & x(i, 4) & "|" & x(i, 5) & "|" & x(i, 15) ' ou ici problement
Next
If .Range("c2") <> "" Then
z = .Range("c2", .Cells(Rows.Count, "c").End(xlUp)).Resize(, 2)
ReDim result(1 To UBound(z), 1 To 150)
For i = 1 To UBound(z)
If z(i, 2) <> "" Then
Gamedata = Me.cmbgame.Text & Me.cmbstand.Text & Me.cmbarea.Text & "|" & z(i, 2) & "|"
temp = Filter(y, Gamedata, 1)
If UBound(temp) > -1 Then
For n = 0 To UBound(temp)
r_split = Split(temp(n), "|")
offs = CLng(r_split(2))
seat = r_split(3)
k = k + offs + 1
result(i, k) = seat
Next
End If
End If
k = 0
Next
.Range("e2").Resize(UBound(result), UBound(result, 2)) = result
End Ifj ai essaye de même de trouver une solution mais je ne suis pas capable alors laisses faire.
par contre si vous avez une macro pour automatiser ce fichier. ça sera vraiment apprécié !
il s agit de ma demande initiale.
c est génial ! bravo !
juste un petit ajustement , j ai besoin d'ajouter des colonnes je t ai fais le résultat voulu dans la feuille BL ~ BDB.
Pour l entête a partir de F1 est ce que on peut le figer comme indique dans la feuille.
j ai ajoute un code pour faire des coleurs et ajustements des colonnes.
merci infinememt
Bonjour
Je ne comprends pas trop
Tu te débrouilles bien avec le VBA et tu as besoin d'aide pour une partie relativement simple
Très bonne astuce pour formater des cellules différemment suivant leur contenu
A voir
merci Banzai64 !
oui je me débrouille bien en VBA mais t es toujours mon sauveur
Merci infiniment !
Salut Banzai64 ,
J ai une petite Question ,je veux savoir comment faire la distribution des données juste pour le nom de feuille qui inscrit dans cellule S2.
merci pour votre aide .
Bonjour
Fais un exemple avec le résultat souhaité
merci voici ci-joint un exemple.
si je tape le nom de feuille dans S2.
merci encore une fois.
Bonjour
Heuu je ne comprends pas
maintenant il n'y a plus qu'une feuille ?
Il faut chercher dans les données de la page "Gamedata" ce qui se rapportent à ce nom et copier juste ces infos ?
C'est à dire le programme d'avant mais en supprimant toutes les pages sauf celle qui est notée en S2 ?