Copier ligne et coller dernière ligne non vide, d'une feuille à l'autre

Bonjour le forum,

Vous commencez à me voir souvent, j'ai un projet d'entreprise depuis plusieurs jours et j'arrive vers la fin.

Aujourd'hui je viens vers vous pour vous demandez une solution à mon problème de copier/coller avec condition.

Voici le code :

Private Sub Critère13_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Sheets("Export").Delete
    Sheets.Add.Name = "Export"
    Sheets("Feuil1").Activate
    'copy 1 maison
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=122, Criteria1:="="
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=66, Criteria1:=Array("Administrations Fiscales", "Centre commercial", "Commerces Unipro", "Ecole Primaire", "Gendarmerie", "Grandes Entreprises", "Hôpital clinique", "Hors mutualisation - sites Orange", "Immeuble en construction", "Obsolète_Aérien", "Obsolète_Immeuble pro majoritaire", "Police", "PSD Light Cellule centralisée", "Risque Aérien", "="), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=33, Criteria1:=Array("ATTENTE PROBATION", "ATTENTE REALISATION PRE-ETUDE", "EN COURS", "EN SIGNATURE", "NON LANCE", "PAS DE SYNDIC", "PRE-ETUDE A DEMANDER", "PRE-ETUDE A VALIDER", "PROTOCOLE A VALIDER", "SIGNE", "SYNDIC NON IDENTIFIE"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=37, Criteria1:="Non"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=128, Criteria1:="=Non", Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=39, Criteria1:="Maison"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=170, Criteria1:="="
    Range("A3").CurrentRegion.Copy
    Sheets("Export").Activate
    ActiveSheet.Paste
    Selection.Insert Shift:=xlDown
    Sheets("Feuil1").Activate
    ActiveSheet.ShowAllData
    'copy 2 immeuble
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=122, Criteria1:="="
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=66, Criteria1:=Array("Administrations Fiscales", "Centre commercial", "Commerces Unipro", "Ecole Primaire", "Gendarmerie", "Grandes Entreprises", "Hôpital clinique", "Hors mutualisation - sites Orange", "Immeuble en construction", "Obsolète_Aérien", "Obsolète_Immeuble pro majoritaire", "Police", "PSD Light Cellule centralisée", "Risque Aérien", "="), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=33, Criteria1:=Array("ATTENTE PROBATION", "ATTENTE REALISATION PRE-ETUDE", "EN COURS", "EN SIGNATURE", "NON LANCE", "PAS DE SYNDIC", "PRE-ETUDE A DEMANDER", "PRE-ETUDE A VALIDER", "PROTOCOLE A VALIDER", "SIGNE", "SYNDIC NON IDENTIFIE"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=37, Criteria1:="Non"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=128, Criteria1:="=Non", Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=39, Criteria1:="Immeuble"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=155, Criteria1:="="
    Range("A3").CurrentRegion.Copy
    Sheets("Export").Activate
    ActiveSheet.Paste
    Sheets("Feuil1").Activate
    ActiveSheet.ShowAllData
    Unload Me
End Sub

Avec ce code cela marche en parti sauf que j'ai des blancs entre mes deux copies. Je suis que c'est dû à la ligne :

Selection.Insert Shift:=xlDown

Vraiment par pitié, est ce que je peut faire un copier/coller à la dernière ligne non vide d'une autre feuille.

Je désespère de ne pas trouvé de solution. Je vous mets aussi le fichier avec toutes les macros (je sais que ce n'est pas optimisé, je ne suis vraiment pas un pro de vba).

Merci d'avance pour votre aide
Bonne journée

Salut,

Ce n'est pas évident pour moi de t'aider, car lorsque je lance ton code, je n'ai pas de blanc entre deux. Pourrais-tu simuler une dizaine ou une vingtaine de ligne sur ta Feuil1 qui montreraient le problème ? A ta place, je prendrais 10 ou 20 données réelles, simplement en remplaçant les données sensibles par des données neutres (par exemple Client 1, Client 2, etc., facile à incrémenter).

A te relire.

Bonjour tous le monde,

Je reviens vers vous après un moment, j'ai simplifié le problème que je rencontre avec seulement 3 filtres.

Pour moi, il est important d'utiliser cette astuce car elle est beaucoup plus rapide que de copier ligne par ligne (à très grande échelle c'est très long).
Cependant avec cette astuce, je n'arrive pas à copier deux sélection à la suite. Comme vous pouvez le voir ci-dessous:

Je vous joints le code ainsi que le fichier:

Sub Formule()
    Sheets("Export").Delete
    Sheets.Add.Name = "Export"
    Sheets("Feuil1").Activate
    'copy 1 premier filtre
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=1, Criteria1:="2"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=2, Criteria1:="SFR"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=3, Criteria1:="Cuivre"
    Range("A3").CurrentRegion.Copy
    Sheets("Export").Activate
    ActiveSheet.Paste
    Sheets("Feuil1").Activate
    ActiveSheet.ShowAllData
    'copy 2 pour laisser la place à la deuxième copy
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=1, Criteria1:="1"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=2, Criteria1:="ORANGE"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=3, Criteria1:="Cuivre"
    Range("A3").CurrentRegion.Copy
    Sheets("Export").Activate
    Selection.Insert Shift:=xlDown
    Sheets("Feuil1").Activate
    ActiveSheet.ShowAllData
    'copy 3 deuxième filtre
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=1, Criteria1:="1"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=2, Criteria1:="ORANGE"
    ActiveSheet.Range("$A$1:$FO$150000").AutoFilter Field:=3, Criteria1:="Cuivre"
    Range("A3").CurrentRegion.Copy
    Sheets("Export").Activate
    ActiveSheet.Paste
    Sheets("Feuil1").Activate
    ActiveSheet.ShowAllData
End Sub

J'espère que cette fois j'ai bien simplifié le problème et vous me comprenez.
Et désolé d'avoir mit le code brute précédemment.

Salut,

Quel est ton problème exactement ? C'est juste les blancs qui sont sur la feuille Export ?

Si c'est bien ca, je vosi deux méthodes assez simple:

• A la fin du programme faire une boucle ou tu test la cellule(n,1)=vide avec ton n qui s'incrémente. Si la cellule est vide tu suppr la ligne.

Cette méthode te permet de modifier et d'aggrandir ton programmes sans soucis.

• Deuxième méthode, tu changes ta facon coller les cellules. Pourquoi insérer des lignes au dessus des tableaux SFR ? Et pas coller à la suite les nouveaux filtres et selections que tu as ?

A+

Salut,

Oui c'est exactement cela mon problème.

Alors pour la première solution je n'y avais pas penser, je vais essayer, merci.

Alors la deuxième solution, c'est ce que je voulais faire de base mais je n'y arrive pas. Tout regrouper sous un tableau à la place de les séparer. Comme cela:

Après si j'ai prit cette façon de copier/coller, c'est pour gagner du temps. J'ai essayé avec la fonction cells mais à grande échelle cela me prend beaucoup trop de temps.

Salut a mon avis la ton problème est réglé avec ca:

J'ai annoté le code pour que tu comprennes ma démarches, hésite pas a demander si certaines choses ne sont pas clairs.

Salut,

Vraiment merci pour la solution. Tu ne peux pas savoir à quel point j'ai bloqué dessus.