Microsoft 365 Copier depuis plusieurs pages d'un fichier une plage de colonnes entre deux cellules comportant un texte particulier

[softy69]

Bonjour à tous,

Je me lance dans un projet de simplification de process Excel en passant par les macros.

Mise en contexte :
Je dispose d'un fichier de X feuilles, sur chaque feuille la partie qui m'intéresse est celle de droite (les 6 dernières colonnes remplies). Je voudrais trouver le code pour identifier cette zone pour chaque feuille. Mon but, une fois cette étape franchie, est de copier cette zone (depuis chaque feuille) et les coller les une en dessous des autres dans une feuille vierge préalablement créée.

Problèmes que je rencontre :
- "Les 6 dernières colonnes" n'ont pas la même adresse sur toutes les feuilles.
- La première ligne des 6 colonnes est une cellule fusionnée avec les 6 colonnes. Cette cellule est non importante à copier.
==> la deuxième ligne des 6 colonnes est une ligne d'en-tête, contenant dans chaque cellule que du texte et ces cellules sont identiques sur toutes les feuilles. (Je me disais qu’utiliser cette plage de valeur en référence serait utile).

Je peux vous joindre un extrait de mon fichier anonymisé et réduit à 3 feuilles pour expliciter mon texte si le projet vous tente. Je profite pour vous dire que le nombre de feuilles peut atteindre 200/250.

Merci d'avance pour votre aide et/ou propositions.

 

[softy69]

(et en plus t'es encore debout à c't'heure-ci ? )

soan

Je suis au R.U donc 1 h de décalage en ma faveur
(j'aimerai tellement voir la tête de mon patron si je lui présente un truc potable dès le matin)

 

[soan]

@softy69

R.U, c'est le Royaume Uni ; alors t'es en Angleterre ? ou au Pays de Galles ? ou en Écosse ?
si t'es en Écosse, t'as p't'être vu le monstre du Loch Ness ? t'es p't'être un immortel,
du clan MacLeod ? ou peut-être juste un simple pêcheur d'Irlande du Nord ?

désolé de te décevoir, mais la Suite B que j'avais prévu d'écrire, c'était que j'connais pas
assez bien la gestion des formes pour pouvoir faire ta dernière demande ; j'allais juste
te mettre ce petit exemple :

Option Explicit

Sub Essai()
  Dim Forme As Shape: Application.ScreenUpdating = 0
  For Each Forme In ActiveSheet.Shapes
    Forme.Delete
  Next Forme
End Sub

c'est un truc dans c'goût-là (non testé !) ; le gel de l'écran est là pour éviter la gêne visuelle
de multiples formes visibles qui disparaissent de l'écran, en un temps plus ou moins long
selon le nombre de formes ; les formes non visibles sont elles aussi supprimées.

c'est pour une seule feuille ; à adapter pour le faire sur toutes les feuilles du classeur !

AVANT d'utiliser cette sub, tu peux faire une vérification préalable en mettant à la place
de Forme.Delete : MsgBox Forme.Name (ATTENTION : tu pourrais avoir des surprises, et
découvrir qu'avec .Delete, tu aurais failli supprimer une forme à laquelle tu tiens !).

Tant pis ! c'est pas grâce à moi qu'tu pourras voir la tête de ton patron demain matin !
si jamais il râle, dis-lui : « c'est pas grave, désormais, c'est moi qui vais diriger la boîte,
alors allez vous reposer ! » petite précision : le « moi » de c'qui est entre guillemets, c'est toi,
hein ? pas moi !

soan

 

[softy69]

R.U, c'est le Royaume Uni ; alors t'es en Angleterre ? ou au Pays de Galles ? ou en Écosse ?
si t'es en Écosse, t'as p't'être vu le monstre du Loch Ness ? t'es p't'être un immortel,
du clan MacLeod ? ou peut-être juste un simple pêcheur d'Irlande du Nord ?

Je suis simplement au pays de galles rien de particulier à signaler ici.

Option Explicit

Sub Essai()
  Dim Forme As Shape: Application.ScreenUpdating = 0
  For Each Forme In ActiveSheet.Shapes
    Forme.Delete
  Next Forme
End Sub

c'est un truc dans c'goût-là (non testé !) ; le gel de l'écran est là pour éviter la gêne visuelle
de multiples formes visibles qui disparaissent de l'écran, en un temps plus ou moins long
selon le nombre de formes ; les formes non visibles sont elles aussi supprimées.

AVANT d'utiliser cette sub, tu peux faire une vérification préalable en mettant à la place
de Forme.Delete : MsgBox Forme.Name (ATTENTION : tu pourrais avoir des surprises, et
découvrir qu'avec .Delete, tu aurais failli supprimer une forme à laquelle tu tiens !).

Ça marche j'imbriquerai ça demain dans la matinée

Tant pis ! c'est pas grâce à moi que tu pourras voir
la tête de ton patron demain matin !

Tu peux peut-être m'aider sur la reconnaissance de caractères ?
Je voudrais dire
1) si cell (a,i) contient "ID" seulement
2) si cell (a,i) contient ("D" puis six chiffres)
3) si cell (a,i) de type nombre

Merci par avance et pout tout

 

[soan]

on s'est croisés, alors t'as pas dû voir les dernières modifs de mon post #32 ;
relis-le pendant que j'vais taper laborieusement ma réponse à ton post #33.

PS : ça ira sûrement plus vite si tu m'envoies ta secrétaire !!!

soan

 

[soan]

@softy69

alors 1ère recommandation importante : crée un monstre du Pays de Galles :
ça fera venir les touristes !!! et si ton patron est suffisamment affreux et
moche à faire peur, offre-lui le job !!! (en lui disant qu'il a la tête de l'emploi !)

-----------------------------------------------------------------------------------------------

imbrique, imbrique, mais soit bien prudent : j'voudrais pas qu'tu effaces par
mégarde des formes indispensables au fonctionnement de ton vrai fichier !

-----------------------------------------------------------------------------------------------

pour la reconnaissance de caractères :

* code VBA pour ton 1) : If Cells(a, i) = "ID" Then MsgBox "ID"

* code VBA pour ton 3) : If IsNumeric(Cells(a, i)) Then MsgBox "Donnée numérique"

* code VBA pour ton 2) :

If Left$(Cells(a, i), 1) = "D" Then
  If IsNumeric(Val(Mid$(Cells(a, i), 2, 6))) Then
    MsgBox "Donnée commençant par D et 6 chiffres"
  End If
End If

les 2 premiers sont très faciles ; celui-là est plus dur ; on doit pouvoir faire mieux,
et peut-être en utilisant le mot-clé VBA Like ? (je n'parle pas d'un "J'aime" ! )

soan

 

[softy69]

Bonjour @soan ,

La première recommandation a beaucoup fait rire mon patron, je lui ai envoyé le lien et le #du post.

--------------------------------------------------

imbrique, imbrique, mais soit bien prudent : j'ne voudrais pas qu'tu effaces par mégarde des formes indispensables au fonctionnement de ton vrai fichier !

Sur ce point la j'ai fait un peu mieux que ça.... une pause ! Et ça m'a permis de me rendre compte d’une chose que je ne vous ai pas dites .... je suis cachottier a ma propre insu

Le fichier sur lequel on bosse provient d'une conversion PDF ==> Excel faite en ligne.

1- Vous vous rappelez les colonnes "ID" qui ne commençaient pas toutes en Q ?

Et bah en effectuant la même conversion de fichier avec Adobe Pro les colonnes "ID" commencent toutes en CS

2-Vous vous rappelez les feuilles blanches qui étaient insérées entre mes feuilles complétées ?

Et bah en effectuant la même conversion de fichier avec Adobe Pro tout est sur une seule page

-----------------------------------------------------

Du coup avec toutes ces péripéties je vois le bout du tunnel. J'ai un code qui fonctionne !

Option Explicit


Sub DeleteLeftColumns()
 Application.ScreenUpdating = False
 Dim shp As Shape
 
    Range("A1:M65536").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        
 For Each shp In ActiveSheet.Shapes
   shp.Delete
 Next shp
 End With
   Columns("A:CR").Select     ' S�lectionne la plage de colonnes
   Selection.Delete           ' suprimmer la section
  
End Sub

Sub cleanning()
 Dim lig&, k&
 Application.ScreenUpdating = False
  With Worksheets(1)
: k = .[A65536].End(3).Row
 For lig = k To 1 Step -1
 
    If Cells(lig, 1) = "ID" Or IsNumeric(Cells(lig, 1)) Or Left$(Cells(lig, 1), 1) = "D5" Then
            Else: Rows(lig).Delete
    End If
    
    If Application.CountA(.Rows(lig)) = 0 Or Cells(lig, 1) = "TITLE" Or Cells(lig, 1) = "" Then
          Rows(lig).Delete
        
    End If
 Next
 
MsgBox "FINISH"
End With
End Sub

--------------------

Les problèmes que je rencontre, je l'espère et corrigez-moi si je me trompe, sont de niveau optimisation, a la fois niveau écriture et temps d'exécution.

- Le temps d'ouverture du fichier est extra long, car trop de formes et d'images a charger d'un coup sur une feuille (sur le fichier joint elles sont supprimées). Avez-vous une idée pour y remédier ?

- Le temps d'exécution des deux macros est aussi très long. J'ai lu quelque par qu'on peut scander la phase sélection de la phase modification dans le code. Vous êtes adeptes de cela ?

 

[soan]

@softy69

il est sympa, ton patron : il a le sens de l'humour !

mais pourquoi tu m'vouvoies, tout à coup ? tu peux m'tutoyer, comme au début !

j'suis content qu'ce soit mieux avec Adobe Pro, et comme toutes les colonnes "ID"
commencent en CS, y'a plus besoin de devoir détecter où est située la dernière
colonne du tableau ; mais pour les lignes vides en trop, il en reste encore !

tableau 1 : lignes 3 et 13
tableau 4 : lignes 140, 142 et 144
tableau 5 : lignes 194 ; 196 ; 197 ; 199 et 201

et y'a encore plein d'cellules fusionnées !

tableaux 6 et en dessous : idem

À propos de la fin de ton post :

pour les formes et images, pas d'idée ; et oui, c'est mieux d'éviter les .Select chaque fois
que possible ! je mets des .Select uniquement quand y'a pas moyen d'faire autrement.

Pour le code VBA, 1ère sub :

Option Explicit

'à propos de tout ce qui était dans le With .. End With :

'a) on peut garder uniquement la suppression des formes

'b) tout le reste est des modifs de la plage A1:M65536,
'   or les colonnes A à M sont incluses dans le "A:CR"
'   des colonnes que tu supprimes juste avant End Sub,
'   donc c'est inutile !

'=> maintenant, ça fait ceci : pour la feuille active,
'suppression de toutes toutes les formes et de "A:CR"

Sub DeleteLeftColumns()
  Dim shp As Shape
  Application.ScreenUpdating = False
  For Each shp In ActiveSheet.Shapes
    shp.Delete
  Next shp
  Columns("A:CR").Delete
End Sub

Pour le code VBA, 2ème sub :

Il y a : With Worksheets(1) ; avec la 1ère feuille du classeur ; donc juste dessous :
k = .[A65536].End(3).Row est sur la 1ère feuille : OK ; mais ensuite, quand il y a :
Cells(lig, 1) : c'est sur la feuille active ; est-ce bien ça ? ou si tu as oublié de
mettre le point, ça aurait dû être sur la 1ère feuille ? si tu as oublié le point,
et que la feuille active n'est pas la 1ère feuille du classeur : big problem !
alors revérifie toutes les références à telle ou telle feuille, implicite ou explicite.

Vérifie bien les conditions des 2 If car j'suis vraiment pas sûr que c'est c'que
tu veux vraiment ! alors fais tes essais sur une copie du fichier Excel !!!

Sub cleanning()
  Dim lig&, k&
  Application.ScreenUpdating = False
  With Worksheets(1)
    k = .[A65536].End(3).Row
    With Cells(lig, 1)
      For lig = k To 1 Step -1
        If .Value <> "ID" And Not IsNumeric(.Value) And Left$(.Value, 1) <> "D" Then
          Rows(lig).Delete
        End If
        If Application.CountA(.Rows(lig)) = 0 Or .Value = "TITLE" Or .Value = "" Then
          Rows(lig).Delete
        End If
      Next lig
    End With
  End With
  MsgBox "FINISH"
End Sub

soan

 

[softy69]

Bonjour soan,
j'espère que TU vas bien et que tout se passe bien autour de TOI. Quand je vouvoie c'est pck je me dis il y a potentiellement quelques lecteurs ... haha

j'suis content que ce soit mieux avec Adobe Pro, et comme toutes les colonnes "ID"
commencent en CS, il y a plus besoin de devoir détecter où est située la dernière
Colonne du tableau ; mais pour les lignes vides en trop, il en reste encore !

Oui c'est tellement plus simple comme ça, je vais quand même regarder si je peux faire la conversion de fichier vers différentes pages pour une question pratique et d'exploitation poussée derrière.

Et il y a encore plein de cellules fusionnées !

Justement les fameuses lignes ci-dessous servent à défusionner toutes les cellules et recentrer les textes et désactiver le renvoie à la ligne du texte

    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False

Il y a : With Worksheets(1) ; avec la 1ère feuille du classeur ; donc juste dessous :
k = .[A65536].End(3).Row est sur la 1ère feuille : OK ; mais ensuite, quand il y a :
Cells(lig, 1) : c'est sur la feuille active ; est-ce bien ça ? ou si tu as oublié de
mettre le point, ça aurait dû être sur la 1ère feuille ? si tu as oublié le point,
et que la feuille active n'est pas la 1ère feuille du classeur : big problem !
alors revérifie toutes les références à telle ou telle feuille, implicite ou explicite.

Vérifie bien les conditions des 2 If car j'suis vraiment pas sûr que c'est c'que
tu veux vraiment ! alors fais tes essais sur une copie du fichier Excel !!!

Mon classeur n'a qu'une feuille et n'en aura qu'une quoi qu'il arrive *sauf si je trouve le moyen de convertir vers différentes pages* + voir ci-dessous :

Pour le code VBA, 1ère sub : nickel, j'y ai ajouté mes ligne de mise en forme et fonctionne avec un léger gain de temps.

Pour le code VBA, 2ème sub : il ne fonctionne pas. Bloque sur les lignes if, du coup je tourne toujours sur mon ancien, c'est juste très long...

À propos de la fin de ton post :

pour les formes et images, pas d'idée ; et oui, c'est mieux d'éviter les .Select chaque fois
que possible ! je mets des .Select uniquement quand y'a pas moyen d'faire autrement.

Du coup il faudrait que je fasse idem je suppose, mais comment haha ...