Vba copy valeur de ces cellules feuil1 a feuil2
Ordinateur!
Messages postés
1
Statut
Membre
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour
Merci de m'aider a faire un script
chercher un nom sur feuil1 A1:A33
le nom trouve var selectionne cette ligne
Var = InputBox("Mot à rechercher ?")
si var est trouvé A1 :A33 ‘nom’
Sélectionne cette ligne
prendre quelques valeurs de ces cellules de cette ligne
et copier sur feuil2
Ex : copy valeur E3 feuil1 sur feuil2 A1
Copy valeur F3 feuil1 sur feuli2 B3
Copy valeur G3 feuil1 sur feuil2 K2
merci de votre aide pour copie des cellules
Sub test()
With Worksheets("feuil1")
Var = InputBox("Mot à rechercher ?")
For Each Cell In Range("A1:A10")
If Cell.Value = Var Then
Cell.Copy Cell.Offset(0, 3)
Exit For
End If
Next Cell
End With
End Sub
Merci de m'aider a faire un script
chercher un nom sur feuil1 A1:A33
le nom trouve var selectionne cette ligne
Var = InputBox("Mot à rechercher ?")
si var est trouvé A1 :A33 ‘nom’
Sélectionne cette ligne
prendre quelques valeurs de ces cellules de cette ligne
et copier sur feuil2
Ex : copy valeur E3 feuil1 sur feuil2 A1
Copy valeur F3 feuil1 sur feuli2 B3
Copy valeur G3 feuil1 sur feuil2 K2
merci de votre aide pour copie des cellules
Sub test()
With Worksheets("feuil1")
Var = InputBox("Mot à rechercher ?")
For Each Cell In Range("A1:A10")
If Cell.Value = Var Then
Cell.Copy Cell.Offset(0, 3)
Exit For
End If
Next Cell
End With
End Sub
2 réponses
-
Bonjour
sans précisions de ta part, il peut y avoir plusieurs fois le mot dans A1 A10 et le résultat s'incrémente d'une ligne dans la feuille2
Merci d'^tre précis et complet dans les Demandes :o)
Var est un nom réservé par vba
Option Explicit
'-------------
Sub ccm()
Dim Mot As String, Nbre As Byte, cptr As Byte, Lig1 As Long, lig2 As Integer
Application.ScreenUpdating = False
With Sheets("feuil1")
On Error GoTo saisie
Mot = InputBox("Mot à rechercher ?")
Nbre = Application.CountIf(.Range("A1:A10"), Mot)
If Nbre = 0 Then GoTo vide
Lig1 = Cells.Rows.Count
lig2 = 1
For cptr = 1 To Nbre
Lig1 = .Columns("A").Find(Mot, .Cells(Lig1, "A"), xlValues).Row
Sheets("feuil2").Cells(lig2, "A") = .Cells(Lig1, "E")
Sheets("feuil2").Cells(lig2 + 2, "B") = .Cells(Lig1, "F")
Sheets("feuil2").Cells(lig2 + 1, "K") = .Cells(Lig1, "G")
lig2 = lig2 + 1
Next
End With
Exit Sub
'gestionnaire erreur
saisie:
MsgBox "aucune saisie effectuée", vbCritical
vide:
MsgBox Mot & " inconnu dans la liste!", vbCritical
End Sub -
MERCI!
de rien...
