Macro pour une mise en page bien spécifique

Le 09/08/2018 à 08:17

Bonjour à tous,

Je progresse petit à petit grâce à vos interventions et les tutos que je trouve sur ce forum , mais de temps à autres je fais face à des problèmes qui me semblent très compliqués à résoudre.

En voilà un que je n'arrive pas à appréhender :

J'ai extrais d'un logiciel de travail des données sous format Excel que je veux exploiter en les copiant dans un autre classeur.

Or, le fichier Excel a une mise en page qui m'empêche de faire ce copier/coller car le tableau utilise plusieurs colonnes ou lignes pour une seule donnée. Du coup j'aurai besoin de déplacer et supprimer les lignes et colonnes qui ne servent à rien. Mais je ne sais pas si c'est possible. De le faire à la main me prendrait trop de temps, d'autant plus que j'aurai cette manipe à exécuter plusieurs fois par semaine.

Dans le fichier ci-joint, il faudrait que je supprime les lignes 1 à 13 qui ne me servent à rien, puis que je supprime certaines lignes et colonnes des données. Il me faut copier d'abord les données entre M16 et AD16, pour les coller sur la ligne 15 dans les cellules correspondantes… etc pour toutes les lignes paires, qui passent en ligne impaires (M18 à AD18 passe en M17 à AD17...), à partir de la ligne 15 (qui deviendra la ligne 2 si les lignes 1 à 13 sont supprimés). J'ai ensuite les colonnes D, E, H, I, J, K, T, Y, AA, AB et AD qu'il faut également supprimer, mais probablement après avoir annuler la fusion des cellules.

Je ne sais pas si je suis clair, mais vous comprendrez probablement en voyant le fichier. Alors possible ou impossible ?

Ou si vous voyez une autre solution de mise en page…

Merci pour votre aide.

Fabrice

4h5601-occuproomcalendar-20180807-1.zip (19.61 Ko)
Le 09/08/2018 à 08:57

Bonjour,

Une proposition (à coller dans un module VBA, accessible depuis ALT + F11) :

Sub MiseEnPage()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Lmax As Long, Lig As Long

With ActiveSheet
    Lmax = .Range("G" & Rows.Count).End(xlUp).Row - 2 'Détermine la dernière ligne
    .Range("A:AD").UnMerge 'Défusionne
    For Lig = Lmax To 16 Step -2 'Boucle sur les lignes en sautant 1 ligne sur 2
        .Range(.Cells(Lig, 13), .Cells(Lig, 30)).Copy .Range(.Cells(Lig - 1, 13), .Cells(Lig - 1, 30)) 'Copie les infos sur une seule ligne
        .Rows(Lig).Delete Shift:=xlUp 'Supprime la ligne en trop
    Next Lig
    .Range("A:B,D:E,H:K,Y:Y,AA:AB,AD:AD").Delete Shift:=xlToLeft 'Supprime les colonnes inutiles
    .Range("A1:A13").EntireRow.Delete Shift:=xlUp 'Supprime les 13 premières lignes
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
Le 09/08/2018 à 09:17

bonjour

salut Pedro22

Microsoft a travaillé depuis 10 ans à répondre aux besoins des excelliens. Comme ton besoin est très courant, il a répondu à ton attente. Il y a 10 ans.

il a créé ceci : le menu Données, Obtenir, puis choisir sa source

ça ouvre une fenêtre de traitement des données avant que tu cliques sur "Charger"

pas de VBA

apprenons Excel et ses menus géniaux

Le 09/08/2018 à 17:09

Bonjour jmd,

Merci pour ton aide. Effectivement il y a des solutions simple

Toutefois mon problème n'est pas totalement résolu puisque s'il m'a bien séparé les colonnes, il ne l'a pas fait pour les lignes et il ne m'a pas supprimer les colonnes et lignes indésirables. Je ne suis pas certain qu'on puisse donc se passer totalement de la programmation. A moins qu'il y ait une manipe que j'ai mal exécutée. En pièce jointe le résultat obtenu en suivant ton conseil.

6h5601-occuproomcalendar-20180807-1-test-donnees.zip (45.77 Ko)
Le 09/08/2018 à 17:10

Merci Pedro22 Je vais la tester

Le 09/08/2018 à 17:27
Pedro22 a écrit :

Bonjour,

Une proposition (à coller dans un module VBA, accessible depuis ALT + F11) :

Sub MiseEnPage()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Lmax As Long, Lig As Long

With ActiveSheet
    Lmax = .Range("G" & Rows.Count).End(xlUp).Row - 2 'Détermine la dernière ligne
    .Range("A:AD").UnMerge 'Défusionne
    For Lig = Lmax To 16 Step -2 'Boucle sur les lignes en sautant 1 ligne sur 2
        .Range(.Cells(Lig, 13), .Cells(Lig, 30)).Copy .Range(.Cells(Lig - 1, 13), .Cells(Lig - 1, 30)) 'Copie les infos sur une seule ligne
        .Rows(Lig).Delete Shift:=xlUp 'Supprime la ligne en trop
    Next Lig
    .Range("A:B,D:E,H:K,Y:Y,AA:AB,AD:AD").Delete Shift:=xlToLeft 'Supprime les colonnes inutiles
    .Range("A1:A13").EntireRow.Delete Shift:=xlUp 'Supprime les 13 premières lignes
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Super Merci le code fonctionne plutôt bien. Il y a juste 3 colonnes vides qui ne se suppriment pas automatiquement, mais ce n'est pas grand chose. Encore merci

Le 09/08/2018 à 17:29

re

PowerQuery est bien plus puissant que VBA dans ce domaine

3copie-de-h5601-occuproomcalendar-20180807-1-test-donnees.zip (48.98 Ko)
Le 09/08/2018 à 17:34
fapasse a écrit :

Super Merci le code fonctionne plutôt bien. Il y a juste 3 colonnes vides qui ne se suppriment pas automatiquement, mais ce n'est pas grand chose. Encore merci

Il te suffit de les ajouter dans la ligne ci-dessous :

.Range("A:B,D:E,H:K,Y:Y,AA:AB,AD:AD").Delete Shift:=xlToLeft 'Supprime les colonnes inutiles

Profite en quand même pour expérimenter Power Query !

Le 09/08/2018 à 22:38

ca semble puissant power query… vous savez où je peux trouver des tutos ou explications ?

Le 10/08/2018 à 09:01

re

tutos sur le web, j'aime bien youtube

beaucoup en anglais, car nous en France sommes en retard sur ces "nouveautés" de 10 ans

mais il y en a en francais aussi

Rechercher des sujets similaires à "macro mise page bien specifique"