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

Question

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.

yg_be · Answer

bonjour,
partager ton fichier ne peut que nous aider à t'aider.

softy6.9 · Answer

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.

cs_Le Pivert · Answer

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à

softy6.9 · Answer

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 NextApplication.ScreenUpdating = FalseApplication.DisplayAlerts = False'je suprime la feuille paste (si deja existente)Worksheets("PASTE").Delete'Déclare les variablesDim Ws As WorksheetDim der As LongDim derniereligne As LongDim derniercolonne As Integer'je suprime les feuilles videsFor Each Ws In Application.Worksheets    If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then        Ws.Delete    End IfNext'je suprime les images'si autre fonction pour dire garder que text, je veux bienApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseFor Each Ws In ActiveWorkbook.Worksheets      For Each pic In Ws.Pictures        pic.Delete      Next picNext Ws    Application.ScreenUpdating = TrueApplication.DisplayAlerts = True'ajoute la nouvelle Feuille PASTE tout au début du ClasseurSheets.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 macroFor Each Ws In ActiveWorkbook.Worksheets    If Ws.Name <> "PASTE" Then   der = Worksheets("PASTE").Cells(Rows.Count, "A").End(xlUp).Row + 1derniereligne = Ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Rowderniercolonne = Ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).ColumnWs.Range(Ws.Cells(2, derniercolonne - 10), Ws.Cells(derniereligne, derniercolonne)).Copy _    Destination:=Worksheets("PASTE").Range("A" & der)    End IfNext 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 iEnd Sub

softy6.9 · Answer

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