Copier/Coller de cellules entre deux classeurs sous conditio

Bonjour,

j'ai actuellement un code VBA lié a un bouton feuille1 "lancer étalonnage" qui me permet de copier/coller une ligne de la feuille Outillage si il y a dans sa cellule de la colonne "L" dans une autre feuille nommer Feuille3.

J'aimerai au lieu de me copier toute la ligne ce code me copie juste que quelques colonnes spécifiques par exemple la A, B et I.

Voici le code:

Sub Lancerétalonnage()

Dim Lig As Long

Dim Col As String

Dim NbrLig As Long

Dim NumLig As Long

Sheets("Feuille3").Activate ' feuille de destination

Col = "L" ' colonne de la donnée non vide à tester

NumLig = 0

With Sheets("Outillage") ' feuille source

NbrLig = .Cells(65536, Col).End(xlUp).Row

For Lig = 1 To NbrLig

If .Cells(Lig, Col).Value = "Lancer l'étalonnage" Then

.Cells(Lig, Col).EntireRow.Copy

NumLig = NumLig + 1

Cells(NumLig, 1).Select

ActiveSheet.Paste

End If

Next

End With

End Sub

Je joint également le fichier.

Merci d'avance.

Up :s

Bonjour

Tu peux t'en tirer avec

.../...
    If .Cells(Lig, Col).Value = "Lancer l'étalonnage" Then
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveCell.Value = Sheets("Outillage").Range("A" & Lig).Value
      ActiveCell.Offset(0, 1).Value = Sheets("Outillage").Range("B" & Lig).Value
      ActiveCell.Offset(0, 2).Value = Sheets("Outillage").Range("I" & Lig).Value
.../...

Cordialement

Bonsoir,

Une extraction via un filtre élaboré...

Tu peux choisir les titres que tu veux, en rajouter, en enlever...

Bon courage

Sub Lancerétalonnage()
Dim ShOutil As Worksheet, ShExtract As Worksheet 'déclaration des variables
Dim Plg As Range
Dim DerLig As Long
Set ShOutil = Sheets("Outillage"): Set ShExtract = Sheets("Feuille3") 'définition des onglets
With ShOutil 'avec l'onglet "Outillage"
    DerLig = .Cells(Rows.Count, 1).End(xlUp).Row 'calcul de la dernière ligne
    Set Plg = .Range("A1:Q" & DerLig) 'définition de la plage utile
    ShExtract.Range("A1").Value = .Range("A1").Value 'copie des titres dans l'onglet "Feuille3"
    ShExtract.Range("B1").Value = .Range("B1").Value
    ShExtract.Range("C1").Value = .Range("I1").Value
    .Range("Z1").Value = .Range("L1").Value 'mise en place du titre pour le filtre élaboré
    .Range("Z2").Value = "Lancer l'étalonnage" 'mise en place du critère
    Plg.AdvancedFilter action:=xlFilterCopy, CriteriaRange:=.Range("Z1:Z2"), _
        CopyToRange:=ShExtract.Range("A1:C1") 'extraction via un filtre élaboré vers la Feuille3
    .Range("Z1:Z2").Clear 'nettoyage des critères
End With
End Sub

Bonne soirée

Bonjour,

j'ai tester le code de Amadeus et j'ai un problème dans la colonne A il s'affiche " If .Cells(Lig, Col).Value = "Lancer étalonnage" Then".

J'ai donc essayé le code de cousinhub et sa marche niquel.

Merci !

Bonjour

Je n'ai aucune prétention.

Cependant, je me demande quand même si tu as correctement inclus le bout de code que j'ai envoyé?

Car je n'ai aucune erreur.

Cordialement