Macro - rearranger une feuille Excel

Bonjour,

J'ai decouvert votre forum tres instructif.

Je suis un noob en macro mais j'aimerais fqire quelquechose qui me semble pas tres complique:

Dans excel (2010 - anglais) J'ai un tas d'onglet avec des informations dans la colonne A, sur plusieurs lignes:

Tel que - un onglet:

Il

Etait

Une

Fois

Et - un autre onglet:

Une

Grande

Vache

Bleue

J'aimerais mettre dans un onglet different (onglet A) toutes ces informations suivant le format suivant - sur autant de lignes qu'il y a de colonnes:

Il, Etait, Une, Fois

Une, Grande, Vache, Bleue

J'aimerais avoir un bouton qui peut mettre a jour cette onglet A, si je change des infos dans les autres onglets ou si je rajoute ou enleve des onglets.

J'aimerais ensuite sauver cette onglet en fichier .txt sous le meme format.

Est ce possible de faire cela?

Merci d'avance pour votre aide!!

ThorondorT

Bonjour et bienvenu

oui cela est possible, mais sans fichier test peu de personnes te viendrons en aide...

tu peux déjà voir si la fonction copie/collage spéciale -> transpose peut te convenir

fred

Merci de ton message.

J'aurais environ 100 onglets et entre 20 et 60 lignes par onglet, donc la fonction transposer va etre trop juste.

De plus, il me faut une virgule (,) entre chaque 'mot'.

Il faut que j'automatise cela.

Voici le fichier excel type (il y a 3 onglets avec des 'mots' en colonne A dans chaque onglet, a terme il y aura jusque 100 onglets).

C'est pour un jeu multijouer

Merci!

Bonsoir

un essai a tester...

le fichier générer est dans le même dossier ou se trouve ce fichier sous le nom export.txt

fred

Bonjour,

Merci beaucoup! Ca avance bien

2-3 petits trucs a rajouter si possible, pour qu'il puisse etre utilisable:

- Decoupler le fait de mettre toutes les donnees sur le premier onglet & de creer un un fichier txt. Je veux pouvoir avoir aussi avec le fichier excel mis a jour sans devoir faire un fichier texte.

- Mettre un espace apres la virgule entre chaque mot.

Donc par example:

Barracus, Nexor, Kylen, etc...

- Un rajout: Mettrea chaque fois le nom de l'onglet avant la liste des 'mots', suivi de ':'

Par exemple:

ThorondorT: Barracus, Nexor, Kylen, etc...

- Mettre le nom du fichier excel comme nom du fichier txt.

PS: il y avait une micro erreur dans le macro a la fin: noting. Il manquait un h apres le t.

Merci d'avance!

C'est vraiment super!

Thor'

bonjour

voici

fred

Super!

Merci pour ton aide.

On y est presque!

Quelques remarques:

- l'espace apres la virgule n'est mise qu'apres le premier mot. Il faudrait qu'il soit mis a tous les mots.

(edit: ca c'est bon, j'ai reussi a modifer (/edit)

- Est ce possible de mettre un second bouton pour creer un fichier texte?

1er bouton: regroupage des donnees seulement -> donc qu'il ne ferme pas le fichier, ni ne cree de fichier txt,

2eme bouton: creer un fichier txt sans fermer l'excel spreadsheet non plus. Et ouvrir le fichier txt.

- Ne pas mettre d'espace avant le : apres le nom de l'onglet.

Donc:

Thorondor T: etc

(edit) Ca aussi c'est bon! (/edit)

- S'il y a une ligne vide dans un des onglets (ce qui sera possible), il ne faudrait pas que avoir 2 virgules qui se suivent dans le fichier. Il faudrait qu/il ignore cette ligne.

Donc au lieu d'avoir ca (pour le moment sur (edit) le premier onglet (/edit) si je rajoute une ligne vide entre 'Kylen" et "gorrus rav"):

Thorondor T : Barracus, Nexor,Kylen,,Gorrus Rav,etc

Il faudrait ca:

Thorondor T: Barracus, Nexor, Kylen, Gorrus Rav, etc

- Dans le fichier txt, ne pas avoir les guillemets au debut et a la fin de chaque ligne.

Ca va bientot etre completement utilisable et deployable

Merci!

Thor'

re

voici une autre proposition avec tout ce que tu voulais sauf un point

l'enregistrement sans les " " en debut et fin de ligne car je n'arrive pas comprendre un truc si je le fait a la main pas de "" mais si je le fait par macro il y a les "" je te laisse chercher une solution pour ce point précis car j'ai plus le temps

fred

Super, merci!

Je vais chercher.

un dernier bug, mais pas grave du tout: S'il n'y a rien dans la premiere cell d'un onglet, et si j'appuie sur le premier bouton, le nom de l'onglet ne se met pas sur le premier onglet avant la liste des 'mots'.

Mais bon, c'est pas tres grave!

Merci encore pour ton aide.

Thor'

nouvelle version

fred

Merci Fred!

Autre question, relative a l'utilisation:

Chaque joueur doit mettre a jour lui meme son onglet. Je pensais donc mettre sur google spreadsheet pour qu'ils puissent le faire eux meme.

Mais dans ce cas la, je perd le macro

Existe t il un moyen de ne pas perdre le macro (ou de le recuperer apres)?

Thor'

A mon avis cela ne marche pas dans sur un cloud...

mais faut essayer, jamais fait

fred

Oui, ca a pas l'air de marcher....

Ce que je pense faire, c'est mettre dans le cloud un xlsx normal.

Quand les gens l'ont mis a jour, je le telecharge, je copie tous les onglets, sauf le premier.

Puis je colle tous les onglets dans l'xlsm avec macro,

Et je fais tourner le macro

Y a plus simple?

Autre trucs:

- Quand un onglet est vide, j'ai un bug (VBA, ligne en jaune):

shd.Range("A" & i - 1) = Left(shd.Range("A" & i - 1), Len(shd.Range("A" & i - 1)) - 2)

Serait ce possible que quand il n'y a rien dans l'onglet, il ignore cet onglet (ignore completement, ne met rien dans 'l'onglet regroupage') mais ne plante pas?

- Quand la cellule A1 ne contient rien dans un onglet (donc quand il y a quelque chose en A2 par exemple), il ne me met pas le nom de l'onglet avant de mettre les 'mots'

Ca devrait etre jouable a reparer non?

Merci encore Fred!

Thor

plus simple c'est n'avoir que les onglets de tes joueurs sur le cloud sans le premier de synthèse

avoir un fichier avec la macro qu'avec l'onglet de synthèse et copier de l'un vers l'autre...

dernière modif

Sub transpose()
Dim i, j As Integer

Dim shd As Worksheet
Set shd = Sheets(1)
shd.Cells.ClearContents

For i = 2 To Sheets.Count
    If Sheets(i).[A655365].End(xlUp).Row <> 1 Or Not IsEmpty(Sheets(i).[A1]) Then

    For j = 1 To Sheets(i).[A655365].End(xlUp).Row
        If Not IsEmpty(Sheets(i).Range("A" & j)) Then
            If j = 1 Then shd.Range("A" & i - 1) = Sheets(i).Name & ": "
            shd.Range("A" & i - 1) = shd.Range("A" & i - 1) & Sheets(i).Range("A" & j) & ", "
        End If

    Next j
    shd.Range("A" & i - 1) = Left(shd.Range("A" & i - 1), Len(shd.Range("A" & i - 1)) - 2)
End If
Next i
Application.DisplayAlerts = False
ActiveWorkbook.Save

Set shd = Nothing
End Sub

fred

Ah ouais pas mal ca

Je vais voir ce qui est le plus facile, mais ca semble pas mal.

Merci pour avoir resolu le bug.

Dernier truc: c'est possible que quand un onglet est vide, il ne mette pas une ligne vide sur l'onglet de synthese?

Si le 2eme joueur n'a rien, ca fait pour le moment ca:

Thorondor T: (...)

Empire JJ: (...)

Alors qu'il faudrait que ca fasse ca:

Thorondor T: (...)

Empire JJ: (...)

Mais bon, on passe dans l'esthetique la

J'ai regarde un peu le coup des guillements mais j'ai pas encore trouve. Je cherche encore...

encore une modif

Sub transpose()
Dim i, j As Integer
Dim lg As Integer
Dim shd As Worksheet
Set shd = Sheets(1)
shd.Cells.ClearContents
lg = 0
For i = 2 To Sheets.Count

    If Sheets(i).[A655365].End(xlUp).Row <> 1 Or Not IsEmpty(Sheets(i).[A1]) Then
    lg = lg + 1
    For j = 1 To Sheets(i).[A655365].End(xlUp).Row
        If Not IsEmpty(Sheets(i).Range("A" & j)) Then
            If j = 1 Then shd.Range("A" & lg) = Sheets(i).Name & ": "
            shd.Range("A" & lg) = shd.Range("A" & lg) & Sheets(i).Range("A" & j) & ", "
        End If

    Next j
    shd.Range("A" & lg) = Left(shd.Range("A" & lg), Len(shd.Range("A" & lg)) - 2)
End If
Next i
Application.DisplayAlerts = False
ActiveWorkbook.Save

Set shd = Nothing
End Sub

Super!!!

Merci!!!

Pour les guillements, j'ai trouve un gars qui a le meme probleme, et on lui a dit de mettre ca:

Pour éviter ces guillemets,

remplace Write #1, strCopie

par Print #1, strCopie

Mais j'ai pas tout a fait ca dans mon macro

Y a ca aussi sur microsoft help, mais pareil c'est avec write & Print...

https://support.microsoft.com/fr-fr/kb/466415

essaye ceci pour l'enregistrement du txt

mais cela suppose que le fichier txt existe déjà car je l'ouvre je ne créer pas

fred

Sub enregistrement_txt()
Dim cell As Range
Dim Fname As String
Dim strCopie As String
Fname = ThisWorkbook.Name
Fname = Replace(Fname, "xlsm", "txt")
 Open ThisWorkbook.Path & "\" & Fname For Output As #1
For Each cell In Sheets(1).Range("A1:A" & Sheets(1).[A655365].End(xlUp).Row)
        strCopie = cell.Value
        Print #1, strCopie
 Next cell
    Close #1
End Sub

Ok je vais tester ça.

Pas moyen de rajouter du code pour le créer vide a partir du fichier, puis le remplir avec le code que tu as mis?