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

softy -  
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   -
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.
A voir également:

5 réponses

Réponse 1 / 5
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
bonjour,
partager ton fichier ne peut que nous aider à t'aider.
0
Réponse 2 / 5
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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.


0
Réponse 3 / 5
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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à

0
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729 > softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   > cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention  
 
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
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729 > softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   > cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention  
 
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 !
0
Réponse 4 / 5
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
tu peux faire 
Ws.Cells.UnMerge

dans la boucle sur Ws
0
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   > yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention  
 
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
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
"qui cloche": ?

peux-tu choisir "basic" quand tu utilises les balises de code pour partager du VBA?
0
softy6.9 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   > yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention  
 
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
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention  
 
je vois que tu as un Range et deux Rows pour lesquels tu ne précises pas de quelle feuille il s'agit.
0