XL 2010 Copier coller avec une condition

B

babass78

XLDnaute Occasionnel
Bonjour

J'ai un fichier qui me permet de gérer l'avancement de mes projets.

Dans ma feuille nommée " Nouveau" et plus précisément dans la colonne H, j'ai une liste déroulante avec notamment une cellule "Compensé - Soldé" (quand la ligne est traitée).

Je souhaiterais que ma macro déplace le ou les projets définis comme " Compense - Soldé " vers ma feuille 2 (nommée "Compensés") afin de garder une trace du travail mensuel et d'alléger le visuel de ma feuille Nouveau

Je voudrais faire en sorte que les lignes s'additionnent les unes sous les autres sans repartir à chaque fois au début de mon tableau et sans supprimer ceux déjà présents

Je ne sais pas si c'est bien clair...

Merci de votre aide
 

Pièces jointes

  • 2018 05 15 - Excel Download - copier les données dans une auitre feuille.xlsm
    960.3 KB · Affichages: 23
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Babass, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim X As Integer 'déclare la variable X (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim TLAE() As Variant 'déclare la variable TLAE (Tableau des Lignes À Effacer)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Nouveau") 'définit l'onglet source OS
Set OD = Worksheets("Compensés") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les données du tableau TV (en partant de la ligne 2)
    If TV(I, 8) = "Compensé - Soldé" Then 'condition : si la donnée ligne I colonne 8 (=> colonne H) du tableau des valeurs TV est égale à "Compensé - Soldé"
        ReDim Preserve TL(1 To 10, 1 To K) 'redimensionne le tableau des lignes TL (10 lignes, K colonnes)
        ReDim Preserve TLAE(1 To K) 'redimensionne le tableau des lignes à effacer TLAE (K lignes)
        TLAE(K) = I 'récupère dans le tableau des lignes à effacer le numéro de la ligne I
        For J = 1 To 10 'boucle 2 : sur les 10 colonnes du tableau des lignes TL
            TL(J, K) = OS.Cells(I, J) 'récupere dans la ligne J de TL la valeur de la cellule en colonne J de l'onglet OS (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL et une ligne au tableau des lignes à effacer TLAE)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If OD.Range("A2").Value = "" Then 'si la cellule A2 de l'onglet OD est vide
    Set DEST = OD.Range("A2") 'définit la cellule de destination DEST (A2)
Else 'sinon
    Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A)
End If 'fin de la condition
DEST.Resize(UBound(TL, 2), 10).Value = Application.Transpose(TL) 'renvoie dans la cellule DEST redimensionnée le tableau TL transposé
For I = UBound(TLAE, 1) To LBound(TLAE, 1) Step -1 'boucle inversée sur toutes les données du tableau TLAE
    OS.Rows(TLAE(I)).Delete 'efface la ligne de la boucle dans l'onglet source OS
Next I 'prochane donnée de la boucle
End Sub
Bonjour Jacky nos posts se sont croisés...
 
Vote positif 0 Vote négatif
B

babass78

XLDnaute Occasionnel
J'ai une autre demande :

1er soucis :

L’onglet Liste clts frns àpartir de O reprend les données des colonnes K à Q de l’onglet RECAP FRNS

Dès que la macro est exécutée, les formules ne fonctionnent plus

Existe-t-il une autre formule ?

2ème soucis :

Onglet Nouveau : Je souhaiterai copier les colonnes de K à Q (onglet RECAP FRNS) vers l’onglet Nouveau à partir de T en bas du tableau

Pour ce faire, il y a une variable qui rentre en compte

Je donne un exemple ce sera plus parlant

Dans Liste clts frns, si je trouve MV MEDIA SAS18351 (d’après la formule qui reprend RECAP FRNS) alors la formule dans l’onglet Nouveau va le retrouver (en jaune)

Mais

S’il trouve MV MEDIA SAS18351

Je souhaiterai que les données de RECAP FRNS (Colonnes K à Q) soient copiées dans Nouveau à la fin à partir de la colonne T mais sans prendre ceux qui se trouent dèjà dans Nouveau

Je ne sais pas si je suis assez clair

Merci à vous
 

Pièces jointes

  • Excel download - Copier coller selon 1 onglet et sans doublons.xlsm
    298.8 KB · Affichages: 20
Vote positif 0 Vote négatif
B

babass78

XLDnaute Occasionnel
Robert à dit:
Bonjour Babass, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim X As Integer 'déclare la variable X (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim TLAE() As Variant 'déclare la variable TLAE (Tableau des Lignes À Effacer)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Nouveau") 'définit l'onglet source OS
Set OD = Worksheets("Compensés") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les données du tableau TV (en partant de la ligne 2)
    If TV(I, 8) = "Compensé - Soldé" Then 'condition : si la donnée ligne I colonne 8 (=> colonne H) du tableau des valeurs TV est égale à "Compensé - Soldé"
        ReDim Preserve TL(1 To 10, 1 To K) 'redimensionne le tableau des lignes TL (10 lignes, K colonnes)
        ReDim Preserve TLAE(1 To K) 'redimensionne le tableau des lignes à effacer TLAE (K lignes)
        TLAE(K) = I 'récupère dans le tableau des lignes à effacer le numéro de la ligne I
        For J = 1 To 10 'boucle 2 : sur les 10 colonnes du tableau des lignes TL
            TL(J, K) = OS.Cells(I, J) 'récupere dans la ligne J de TL la valeur de la cellule en colonne J de l'onglet OS (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL et une ligne au tableau des lignes à effacer TLAE)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If OD.Range("A2").Value = "" Then 'si la cellule A2 de l'onglet OD est vide
    Set DEST = OD.Range("A2") 'définit la cellule de destination DEST (A2)
Else 'sinon
    Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A)
End If 'fin de la condition
DEST.Resize(UBound(TL, 2), 10).Value = Application.Transpose(TL) 'renvoie dans la cellule DEST redimensionnée le tableau TL transposé
For I = UBound(TLAE, 1) To LBound(TLAE, 1) Step -1 'boucle inversée sur toutes les données du tableau TLAE
    OS.Rows(TLAE(I)).Delete 'efface la ligne de la boucle dans l'onglet source OS
Next I 'prochane donnée de la boucle
End Sub
Bonjour Jacky nos posts se sont croisés...
Cliquez pour agrandir...



Re bonjour

La macro fonctionnait bien et j’ai un message d’erreur


Erreur d’exécution 13

Incompatibilité de type


Pouvez-vous m’aider

Je joins le fichier

Merci à vous
 

Pièces jointes

  • VBA - Copier coller avec une condition Compensé Soldé.xlsm
    1 005.6 KB · Affichages: 21
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
babass78 à dit:
La macro fonctionnait bien et j’ai un message d’erreur

Erreur d’exécution 13

Incompatibilité de type

Pouvez-vous m’aider

Merci à vous
Cliquez pour agrandir...

Beaucoup moins rapide mais fonctionnelle :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set OS = Worksheets("Nouveau") 'définit l'onglet source OS
Set OD = Worksheets("Compensés") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = UBound(TV, 1) To 1 Step -1 'boucle inversée de la dernière ligne à la première
    If OS.Cells(I, 8) = "Compensé - Soldé" Then 'condition 1 : si la valeur de la cellule en ligne I colonne 8 de l'onglet OS vaut "Compensé - Soldé"
        If OD.Range("A2").Value = "" Then 'condition 2: si la cellule A2 de l'onglet OD est vide
            Set DEST = OD.Range("A2") 'définit la cellule de destination DEST (A2)
        Else 'sinon
            Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A)
        End If 'fin de la condition 2
        OS.Rows(I).Cut DEST 'coupe la ligne I et la colle dans dest
        OS.Rows(I).Delete 'supprime la ligne I (vide)
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
154
marie3107
M
I
  • Question
XL 2016 Copier vers les feuilles avec condition
Réponses
4
Affichages
347
INFINITY100
I
B
  • Question
XL 2010 copier et coller une colonne sur une colonne avec filtre
Réponses
2
Affichages
379
bitissa
B
D
  • Question
XL 2016 macro pour copier coller des cellules d'une feuille dans une autre feuille avec condition
Réponses
2
Affichages
256
Phil69970
Phil69970
C
  • Question
XL 2016 Copier et coller une valeur dans plusieurs Listobjects d'une même feuille
Réponses
5
Affichages
239
chris
chris
N
  • Question
XL 2019 Formule pour copier/coller une valeur
Réponses
2
Affichages
611
Naia
N
A
  • Résolu(e)
XL 2010 Copier / Coller un bouton de commande (activex) avec son code dans plusieurs feuilles
Réponses
2
Affichages
544
Alappero
A
6
  • Résolu(e)
XL 2019 Copier-coller tableau dans une feuille de calcul via VBA
Réponses
11
Affichages
783
job75
job75
Dadi147
  • Question
XL 2016 Copier une feuille avec une condition de valeur dans une colonne
Réponses
6
Affichages
434
job75
job75
F
  • Question
XL 2019 Copier un ligne dans une autre feuille sous condition
Réponses
7
Affichages
536
FredNVZ
F

Membres actuellement en ligne

9 membres et 101 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 224
Messages
2 086 410
Membres
103 201
dernier inscrit
centrale vet