Copier depuis plusieurs pages d'un fichier une plage de colonnes entre deux cell

Signaler
-
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020
-
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.

5 réponses

Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020
719
bonjour,
partager ton fichier ne peut que nous aider à t'aider.
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

Bonjour à toi et merci pour ta réactivité ;

ci-joint une capture d’écran de mon fichier parce que je n'ai pas réussi à joindre le fichier Excel.
Les cellules sélectionnées sont celles qui m'intéressent à la fin, mais des lignes blanches sont cachées par-ci par-là, du coup la fonction atteindre première ligne vide marche pas. J'envisage de copier la zone jusqu'a ligne 50 et supprimer les lignes blanches, mais ce n'est pas la priorité).
Merci d’avance.


Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020
564
Bonjour,

une première approche pour sélectionner la plage de cellule:

https://docs.microsoft.com/fr-fr/previous-versions/office/troubleshoot/office-developer/select-cells-rangs-with-visual-basic
https://excel-malin.com/tutoriels/vba-tutoriels/vba-trouver-la-derniere-cellule-utilisee/

Option Explicit
Sub test()
Dim derniereligne As Long
Dim derniercolonne As Integer
derniereligne = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
derniercolonne = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
ActiveSheet.Range(ActiveSheet.Cells(1, derniercolonne - 5), ActiveSheet.Cells(derniereligne, derniercolonne)).Select
End Sub


Il suffit de faire une boucle sur toutes les feuilles. A la place du select mettre copie vers destination

https://silkyroad.developpez.com/VBA/FeuilleDeCalcul/

https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.copy

Voilà

Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

Bonjour cs_LePivert,

Merci beaucoup ça marche presque à merveille.
Je ne veux pas des lignes de cartouche, ce qui m'intéresse est uniquement les colonnes à droite.

Je suis débutant en vba, pouvez-vous me faire cette modification le temps que je comprenne la logique utilisée et que je parcours les liens que vous m'avez suggérés ?

merci encore.
Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020
564 >
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

comme ceci a adapter le nom de la feuille receptrice. Démarre à la ligne 2

Option Explicit
Sub boucle()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet
Dim der As Long
Dim derniereligne As Long
Dim derniercolonne As Integer
'Boucle sur toutes les feuille de calcul du classeur. Les onglets graphiques ne sont pas pris
'en compte.
'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Feuil1" Then ' adapter nom de la feuille
   der = Worksheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row + 1
derniereligne = Ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
derniercolonne = Ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
Ws.Range(Ws.Cells(2, derniercolonne - 5), Ws.Cells(derniereligne, derniercolonne)).Copy _
    Destination:=Worksheets("Feuil1").Range("A" & der)
    End If
Next Ws
End Sub


Voilà

@+ Le Pivert
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020
>
Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020

Merci pour votre temps et aide.
Peut-on plutôt procédé par ordre de feuille plutôt que par nom ?

Je m'explique :
plutôt que dire :si la feuille est nommée X alors copie "ça" et colle-le dans Y ...
Peut-on dire sous forme de boucle a incrémentation : copie "ça"depuis la feuilles 1 et colle-le dans la feuille nommée "PASTE"en colonne A première cellule vide puis idem feuille 2 idem feuille 3 ....

Merci encore
Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020
564 >
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

Je ne suis pas sur de bien comprendre!

voici un code qui crée une feuille nommée PASTE et qui colle les données de toutes les feuilles dans cette même feuille:

Option Explicit
Sub boucle()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet
Dim der As Long
Dim derniereligne As Long
Dim derniercolonne As Integer
'ajoute la nouvelle Feuille tout au début du Classeur
Sheets.Add Before:=Worksheets(1) 'création
Sheets(1).Name = "PASTE" ' renommé
'Boucle sur toutes les feuille de calcul du classeur. Les onglets graphiques ne sont pas pris
'en compte.
'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "PASTE" Then
   der = Worksheets("PASTE").Cells(Rows.Count, "A").End(xlUp).Row + 1
derniereligne = Ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
derniercolonne = Ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
Ws.Range(Ws.Cells(2, derniercolonne - 5), Ws.Cells(derniereligne, derniercolonne)).Copy _
    Destination:=Worksheets("PASTE").Range("A" & der)
    End If
Next Ws
End Sub


@+ Le Pivert
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020
>
Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020

Votre code fonctionne hyper bien.

Mais.... malheureusement toujours un mais,

Il ne donne que les deux dernières colonnes (SCH / CLASS et DESCRIPTION)
il me faudrait les six dernières colonnes (ID, QTY, MESC., SIZE, SCH / CLASS et DESCRIPTION) de chaque feuille.

Et si en plus on peut y intégrer au même temps une fonction pour supprimer les lignes blanches de la feuille obtenue (PASTE). Je sais le faire tourner seul, mais avec mon niveau je pense il peut être optimisé.

Merci infiniment pour votre temps et aide plus que remarquable !
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

Voilà dans l'esprit le code global que je voudrais obtenir mais ne fonctionne pas sur le fichier global.

Nickel sur le fichier avec 3 feuilles


Sub boucle()

On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'je suprime la feuille paste (si deja existente)
Worksheets("PASTE").Delete


'Déclare les variables

Dim Ws As Worksheet
Dim der As Long
Dim derniereligne As Long
Dim derniercolonne As Integer

'je suprime les feuilles vides


For Each Ws In Application.Worksheets
If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
Ws.Delete
End If
Next

'je suprime les images
'si autre fonction pour dire garder que text, je veux bien

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Ws In ActiveWorkbook.Worksheets
For Each pic In Ws.Pictures
pic.Delete
Next pic
Next Ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True

'ajoute la nouvelle Feuille PASTE tout au début du Classeur
Sheets.Add Before:=Worksheets(1)
Sheets(1).Name = "PASTE" '


'Boucle sur toutes les feuille de calcul du classeur.
'Les onglets graphiques ne sont pas pris en compte.

'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "PASTE" Then
der = Worksheets("PASTE").Cells(Rows.Count, "A").End(xlUp).Row + 1
derniereligne = Ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
derniercolonne = Ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
Ws.Range(Ws.Cells(2, derniercolonne - 10), Ws.Cells(derniereligne, derniercolonne)).Copy _
Destination:=Worksheets("PASTE").Range("A" & der)
End If
Next Ws

'je suprime les lignes blanche ou contenant title en A

For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = "" Or Cells(i, 1) = "TITLE" Then
Rows(i).Delete
End If
Next i

End Sub
Messages postés
6996
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
31 octobre 2020
564
Tout d'abord supprimer:

On Error Resume Next


qui masque toutes les erreurs!

Tu aurais vu que tu avais une erreur si tu supprimais la feuille PASTE si elle n'existait pas!

voir ceci:

https://excel-malin.com/codes-sources-vba/vba-verifier-si-feuille-existe/

ensuite mettre Option Explicit en haut pour t'obliger à déclarer toutes tes variables

lancer la macro et voir où ce situe le bug

Ligne en surbrillance jaune.

passer le curseur sur toutes les variables de cette ligne et voir où ce situe l'erreur

Si cela fonctionne pour 3 feuilles, il doit y avoir un problème à la 4ème feuille!

@+ Le Pivert
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

Bonjour a tous,



Après vérification et quelque modification, ce qui pose problème maintenant c'est les cellules fusionnée qui viennent perturber la suppression des lignes blanches qui elles même perturbe la détection de la première ligne "réellement" vide



Je suis à la recherche de ligne de code qu'on pourrait utiliser, pour dire :

"sur chaque feuille de ce classeur

sélectionner toutes les cellules de la feuille

si la cellule est fusionnée

alors "de-fusionner" en conservant la valeur
sinon rien

cellule suivante
feuille suivante
"


À la suite de ce code je pense pouvoir supprimer les ligne blanches et dérouler les lignes de code pour la sélection des zones à copier/coller depuis toutes les feuilles.



Merci pour votre aide
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020
719
tu peux faire
Ws.Cells.UnMerge

dans la boucle sur Ws
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020
>
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020

Salut Yg_be, merci pour ton retour,

j'ai essayé ça comme ci-dessous, ça "de-fusionne" bien toutes les cellules de chaque feuille. En revanche, quand je l'intègre avec les autres opérations je me rends compte que c'est la fonction "supprimer les ligne blanches de toutes les feuilles" qui cloche...

Est-ce que tu aurais une idée ?

sub cleaning()
Dim P As Long
Dim Ws As Worksheet
Dim sh As Worksheet

On Error Resume Next
Application.ScreenUpdating = False
'Application.DisplayAlerts = False

For Each Ws In Application.Worksheets
If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
Ws.Delete
End If
Next
Application.ScreenUpdating = True
'Application.DisplayAlerts = True


Application.ScreenUpdating = False
For Each sh In Worksheets: sh.Cells.UnMerge:
Next
Application.ScreenUpdating = True

For Each Ws In Worksheets: Ws
For P = Range("A65536").End(xlUp).Row To 1 Step -1
If Application.CountA(Rows(P)) = 0 Then Rows(P).Delete Shift:=xlUp

Next
Next

end sub
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020
719 >
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020

"qui cloche": ?

peux-tu choisir "basic" quand tu utilises les balises de code pour partager du VBA?
Messages postés
8
Date d'inscription
samedi 10 octobre 2020
Statut
Membre
Dernière intervention
11 octobre 2020
>
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020

edit:

sub cleaning()
Dim P As Long
Dim Ws As Worksheet
Dim sh As Worksheet

On Error Resume Next
Application.ScreenUpdating = False
'Application.DisplayAlerts = False

    For Each Ws In Application.Worksheets
        If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
         Ws.Delete
        End If
    Next
Application.ScreenUpdating = True
'Application.DisplayAlerts = True


Application.ScreenUpdating = False
    For Each sh In Worksheets: sh.Cells.UnMerge:
    Next
Application.ScreenUpdating = True

    For Each Ws In Worksheets: Ws
    For P = Range("A65536").End(xlUp).Row To 1 Step -1
        If Application.CountA(Rows(P)) = 0 Then Rows(P).Delete Shift:=xlUp

    Next
    Next
    
end sub
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020
719 >
Messages postés
12879
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
31 octobre 2020

je vois que tu as un Range et deux Rows pour lesquels tu ne précises pas de quelle feuille il s'agit.