XL 2019 copier une colonne si

J

Jerry590

XLDnaute Nouveau
Bonjour à tous,
Je cherche à copier des lignes en fonction deux critères (en quelque sorte un "copie si ") dans un autre onglet "template"et les placer à la suite dans l’onglet "destination", mais je n'arrive pas à l'écrire en VBA.
exemple:
-j'aimerais copier les lignes si [la colonne "Division d'affectation" ]= "Transport " & [la colonne "Société d'affectation"]= "a"
Alors copier la ligne entière sur onglet "destination".
-ensuite j'aimerais copier les lignes si [la colonne "Division d'affectation" ]= "Holding" & [la colonne "Société d'affectation"]= "b"
-enfin j'aimerais copier les lignes si [la colonne "Division d'affectation" ]= "Autres" & [la colonne "Société d'affectation"]= "dacom"
Alors copier la ligne entière sur onglet "destination" à partir de la dernière ligne du fichier.
Je suis bloqué dessus n'arrive pas à le faire.
Merci pour votre compréhension.
 

Pièces jointes

  • aides.xlsx
    224.7 KB · Affichages: 8
Solution
vgendron
avec cette modif de code

en cas d'erreur.. on continue..
ca ne regle pas le problème d'adresse manquante.. et ca ignore l'erreur, quelque soit son origine...
c'est un peu comme quand t'es en voiture.. si plus de frein. et bah.. tu continues quand meme.. advienne que pourra..

VB: 
Sub Transfert2()
Dim ncol%, source As Range, dest As Range, tablo, resu(), d As Object, n&, i&, nn&, j%
ncol = 4 'nombre de colonnes il faut prendre jusqu'à la colonne D

Set source = Sheets("Template").[A1].CurrentRegion.Resize(, ncol)
Set dest = Sheets("Destination").Range("A" & Rows.Count).End(xlUp)(2) '1ère cellule vide

tablo = source 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode...
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
bonjour

pourquoi faire deux fois le meme post?
excel-downloads.com

Microsoft 365 - copier une colonne si

Bonjour à tous, Je cherche à copier des lignes en fonction deux critères (en quelque sorte un "copie si ") dans un autre onglet "template"et les placer à la suite dans l’onglet "destination", mais je n'arrive pas à l'écrire en VBA. exemple: -j'aimerais copier les lignes si [la colonne "Division...
excel-downloads.com excel-downloads.com
vides en un
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
de plus;. tu parles d'onglets template et destination
aucun des deux n'existe dans ton fichier
ton fichier est en xlsx==> il ne contient donc aucun code vba

utilise l'enregistreur de macro
et applique un filtre sur tes données, et tu copies colles le résultat du filtre
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir Jerry590, vgendron,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Template" :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Or Target.Column > 3 Then Exit Sub
Set Target = Cells(Target.Row, 1)
If IsError(Application.Match(Target & Target(1, 2), Array("Transporta", "Holdingb", "AutresDacom"), 0)) Then Exit Sub
Dim c As Range
Cancel = True
With Sheets("Destination")
    Set c = .Cells(.Rows.Count, 1).End(xlUp)(2) '1ère cellule vide
    Target.Resize(, 3).Copy c 'copier-coller
    Application.Goto c 'cadrage facultatif
End With
End Sub
A+
 

Pièces jointes

  • aides(1).xlsm
    449.3 KB · Affichages: 4
Vote positif 0 Vote négatif
J

Jerry590

XLDnaute Nouveau
vgendron à dit:
bonjour

pourquoi faire deux fois le meme post?
excel-downloads.com

Microsoft 365 - copier une colonne si

Bonjour à tous, Je cherche à copier des lignes en fonction deux critères (en quelque sorte un "copie si ") dans un autre onglet "template"et les placer à la suite dans l’onglet "destination", mais je n'arrive pas à l'écrire en VBA. exemple: -j'aimerais copier les lignes si [la colonne "Division...
excel-downloads.com excel-downloads.com
vides en un
Cliquez pour agrandir...
j'ai pas fais attention que le premier était partie ,j'ai eu un problème de connexion et j'ai relancer le poste.
 
Vote positif 0 Vote négatif
J

Jerry590

XLDnaute Nouveau
job75 à dit:
Bonsoir Jerry590, vgendron,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Template" :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Or Target.Column > 3 Then Exit Sub
Set Target = Cells(Target.Row, 1)
If IsError(Application.Match(Target & Target(1, 2), Array("Transporta", "Holdingb", "AutresDacom"), 0)) Then Exit Sub
Dim c As Range
Cancel = True
With Sheets("Destination")
    Set c = .Cells(.Rows.Count, 1).End(xlUp)(2) '1ère cellule vide
    Target.Resize(, 3).Copy c 'copier-coller
    Application.Goto c 'cadrage facultatif
End With
End Sub
A+
Cliquez pour agrandir...
Merci @job75. est ce possible de l'affecter a un bouton car double clics sur chaque ligne reviendrai a faire a la main avec un fichier de plus de 45000 lignes
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Sur 45 000 lignes pour aller vite il faut utiliser des tableaux VBA.

Et en général quand on transfère les données on supprime les lignes de la feuille source.

Voyez ce fichier (2) et la macro du bouton :
VB: 
Sub Transfert()
Dim ncol%, source As Range, dest As Range, tablo, resu(), a, n&, i&, j%, nn&
ncol = 3 'nombre de colonnes
Set source = Sheets("Template").[A1].CurrentRegion.Resize(, ncol)
Set dest = Sheets("Destination").Range("A" & Rows.Count).End(xlUp)(2) '1ère cellule vide
tablo = source 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol)
a = Array("Transporta", "Holdingb", "AutresDacom")
n = 1
For i = 2 To UBound(tablo)
    If IsError(Application.Match(tablo(i, 1) & tablo(i, 2), a, 0)) Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    Else
        nn = nn + 1
        For j = 1 To ncol
            resu(nn, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution des 2 tableaux---
If source.Parent.FilterMode Then source.Parent.ShowAllData 'si la feuille est filtrée
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
source.Resize(n) = tablo
source.Offset(n).Resize(Rows.Count - n - source.Row + 1).ClearContents 'RAZ en dessous
If nn Then dest.Resize(nn, ncol) = resu
dest.Offset(nn).Resize(Rows.Count - nn - dest.Row + 1, ncol).ClearContents 'RAZ en dessous
MsgBox nn & " ligne(s) sur " & n - 1 + nn & " transférée(s)..."
End Sub
Edit : oublié d'initialiser n = 1.
 

Pièces jointes

  • aides(2).xlsm
    453.3 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
J

Jerry590

XLDnaute Nouveau
job75 à dit:
Sur 45 000 lignes pour aller vite il faut utiliser des tableaux VBA.

Et en général quand on transfère les données on supprime les lignes de la feuille source.

Voyez ce fichier (2) et la macro du bouton :
VB: 
Sub Transfert()
Dim ncol%, source As Range, dest As Range, tablo, resu(), a, n&, i&, j%, nn&
ncol = 3 'nombre de colonnes
Set source = Sheets("Template").[A1].CurrentRegion.Resize(, ncol)
Set dest = Sheets("Destination").Range("A" & Rows.Count).End(xlUp)(2) '1ère cellule vide
tablo = source 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol)
a = Array("Transporta", "Holdingb", "AutresDacom")
n = 1
For i = 2 To UBound(tablo)
    If IsError(Application.Match(tablo(i, 1) & tablo(i, 2), a, 0)) Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    Else
        nn = nn + 1
        For j = 1 To ncol
            resu(nn, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution des 2 tableaux---
If source.Parent.FilterMode Then source.Parent.ShowAllData 'si la feuille est filtrée
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
source.Resize(n) = tablo
source.Offset(n).Resize(Rows.Count - n - source.Row + 1).ClearContents 'RAZ en dessous
If nn Then dest.Resize(nn, ncol) = resu
dest.Offset(nn).Resize(Rows.Count - nn - dest.Row + 1, ncol).ClearContents 'RAZ en dessous
MsgBox nn & " ligne(s) sur " & n - 1 + nn & " transférée(s)..."
End Sub
Edit : oublié d'initialiser n = 1.
Cliquez pour agrandir...
merci @job75,c'est bien ce fichier que je telecharge
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Jerry590, le forum,

Avec le Dictionary on gagne quelques dixièmes de seconde sur l'exécution, fichier (3) :
VB: 
Sub Transfert()
Dim ncol%, source As Range, dest As Range, tablo, resu(), d As Object, n&, i&, nn&, j%
ncol = 3 'nombre de colonnes
Set source = Sheets("Template").[A1].CurrentRegion.Resize(, ncol)
Set dest = Sheets("Destination").Range("A" & Rows.Count).End(xlUp)(2) '1ère cellule vide
tablo = source 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
d("Transporta") = "": d("Holdingb") = "": d("AutresDacom") = ""
n = 1
For i = 2 To UBound(tablo)
    If d.exists(tablo(i, 1) & tablo(i, 2)) Then
        nn = nn + 1
        For j = 1 To ncol
            resu(nn, j) = tablo(i, j)
        Next j
    Else
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution des 2 tableaux---
If source.Parent.FilterMode Then source.Parent.ShowAllData 'si la feuille est filtrée
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
source.Resize(n) = tablo
source.Offset(n).Resize(Rows.Count - n - source.Row + 1).ClearContents 'RAZ en dessous
If nn Then dest.Resize(nn, ncol) = resu
dest.Offset(nn).Resize(Rows.Count - nn - dest.Row + 1, ncol).ClearContents 'RAZ en dessous
MsgBox nn & " ligne(s) sur " & n - 1 + nn & " transférée(s)..."
End Sub
Pour tester j'ai copié le tableau source sur 58 000 lignes, chez moi sur Win 11 Excel 2019 :

- fichier (2) => 0,75 seconde

- fichier (3) => 0,375 seconde.

A+
 

Pièces jointes

  • aides(3).xlsm
    453.6 KB · Affichages: 9
Vote positif 0 Vote négatif
J

Jerry590

XLDnaute Nouveau
Bonjour je reviens vers vous,car j'aimerais extraire le "domaine" (en rouge dans l'exemple) d'une adresse mail(exemple: prenom.nom@xxxxxxx.net) qui se trouve en colonne BZ ,et ensuite concaténer avec la colonne BN , si les deux colonnes sont différents de vide.
Bien entendu je sais le faire formule mais utilitée est de l'avoir en VBA.
Merci de votre compréhension.
 
Vote positif 0 Vote négatif
J

Jerry590

XLDnaute Nouveau
job75 à dit:
Bonjour à tous,

Je vais être absent pendant 2 à 3 semaines.

A+
Cliquez pour agrandir...
Sub Concat3()
Dim conc(), n&, i&
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1") = "Concatenation(Division&EmailPro)"
With ActiveSheet
n = .Cells(.Rows.Count, 67).End(xlUp).Row
i = .Cells(.Rows.Count, 79).End(xlUp).Row
n = IIf(i > n, i, n)
ReDim conc(1 To n - 1, 1 To 1)
For i = 2 To n
If .Cells(i, 67) <> "" Or .Cells(i, 79) <> "" Then
conc(i - 1, 1) = trim(.Cells(i, 67) & " " & (Split(.Cells(i, 79).Value, "@")(1)))
End If
Next i
.Cells(2, 1).Resize(n - 1).Value = conc
End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
Microsoft 365 copier une colonne si
Réponses
1
Affichages
329
job75
job75
E
  • Résolu(e)
Microsoft 365 copier coller Resize
2 3 4
Réponses
56
Affichages
1 K
Phil69970
Phil69970
A
  • Question
XL 2019 Ajouter ou supprimer une ligne selon un mot trouvé dans une autre feuille
Réponses
1
Affichages
147
Oneida
Oneida
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Copier Colonne vers ligne
Réponses
6
Affichages
122
chaelie2015
chaelie2015
M
  • Question
XL 2021 Copier une cellule sur deux et coller dans une autre colonne
Réponses
5
Affichages
176
DJunqueira
D
X
  • Question
XL 2010 copier la valeur d'une cellule, si date du jour correspond à la date de la colonne...
Réponses
1
Affichages
266
djidji59430
djidji59430
B
  • Question
XL 2019 formule
Réponses
6
Affichages
415
JHA
J
Usine à gaz
  • Résolu(e)
XL 2021 Commentaires automatiques
2
Réponses
22
Affichages
716
TooFatBoy
TooFatBoy
Y
  • Question
XL 2019 copier/coller colonne vers ligne
Réponses
4
Affichages
252
sylvanu
sylvanu
R
  • Question
Microsoft 365 Fonction DECALER - mais décaler aussi les couleurs
Réponses
4
Affichages
133
rastafouette
R

Membres actuellement en ligne

17 membres et 338 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 178
Messages
2 085 984
Membres
103 079
dernier inscrit
sle