XL 2013 Executer une macro apres un GetOpenFilenam RESOLUe

[Kirua27]

Bonjour a tous et merci d'avance pour l'aide que vous pourrez m'apporter.

Voila mon problème, je cherche a faire une copie de donné depuis un classeur à aller chercher via GetOpenFilename,
Voici la portion de code que j'ai mais à la ligne Set Plage = Sheets("Feuil1").Range("A4:A500") arrêt de la macro

If MsgBox("Avez-vous remplis des cellules en manuel?", vbYesNo, "Demande de confirmation") = vbNo Then
ChDrive "S"
ChDir "S:\XXX\XXX"
ret = Application.GetOpenFilename
If ret <> True Then
Dim c As Range, Plage As Range, Plage1 As Range, Result As Range
Set Plage = Sheets("Feuil1").Range("A4:A500") ' & Cells(Cells.Rows.Count, 1).End(xlUp))
Set Plage1 = Plage.Offset(, -5).Resize(, 6)
For Each c In Plage
If c.Value = "VA" Then
If Result Is Nothing Then
Set Result = Plage1.Rows(c.Row)
Else
Set Result = Union(Result, Plage1.Rows(c.Row))
End If
End If
Next c
If Not Result Is Nothing Then Result.Copy


End If
End If

Dans cette macro je veux ouvrir un fichier sans l'ouvrir, copier les donnés entre les colonnes A et F, dont les lignes de la colonne A contienne les caractère "VA", puis les copier dans la feuille active en "B5".

Avez-vous des suggestions à me communiquer pour que ce code fonctionne?
PS: Je suis débutant en VBA.

 

[youky(BJ)]

Bienvenu sur XLD,
Comme tu n'as pas mis de fichier test, je n'ai pas testé ma macro
Pas envie de tout refaire
Donc la voici, il t'apprtiens de la mettre dans le bon context.
Bruno

Sub macopie()
Dim Wb As Workbook
If MsgBox("Avez-vous remplis des cellules en manuel?", vbYesNo, "Demande de confirmation") = vbNo Then
'ChDrive "S"
'ChDir "S:\XXX\XXX"
rep = Application.GetOpenFilename
If rep <> True Then
Set Wb = GetObject(rep) 'ouverture en invisible
With Wb.Sheets("Feuil1")
'le point indique que l'on indique l'onglet du fichier choisit
bas = .[A65000].End(3).Row
i = 5 'pour commencer en ligne 5
'on copie A-F en B-G de la feuille active
For lig = 4 To bas
If .Cells(lig, 1) = "VA" Then
'copie que des valeurs
Range("A" & i & ":F" & i).Value = .Range("B" & lig & ":G" & lig).Value
i = i + 1
Next
End With
Wb.Close 'ferme le fichier
End Sub

 

[Kirua27]

Merci ton code m'a beaucoup aidé, j'y ai apporter quelque ajustement et cela fonctionne parfaitement merci encore

Sub macopie()
Dim Wb As Workbook
If MsgBox("Avez-vous remplis des cellules en manuel?", vbYesNo, "Demande de confirmation") = vbNo Then
'ChDrive "S"
'ChDir "S:\XXX\XXX"
rep = Application.GetOpenFilename
If rep <> True Then
Set Wb = GetObject(rep) 'ouverture en invisible
With Wb.Sheets("Feuil1")
'le point indique que l'on indique l'onglet du fichier choisit
bas = .[A65000].End(3).Row
i = 5 'pour commencer en ligne 5
'on copie A-F en B-G de la feuille active
For lig = 4 To bas
If .Cells(lig, 1) = "VA" Then
'copie que des valeurs
Range("B" & i & ":H" & i).Value = .Range("A" & lig & ":G" & lig).Value
i = i + 1
End If
Next lig
End With
Wb.Close 'ferme le fichier
End If
End If
End Sub

 

[Kirua27]

Petite question comment on valide une réponse pour clore la discussion?

 

[Kirua27]

Autre questions si possible j'aimerais sélectionner plusieurs valeur différentes pour les copier dans ma feuille
à la ligne:

If .Cells(lig, 1) = "VA" Then

J'aimerais inscrire en plus de "VA", d'autre caractère comme "CL", "EC" ect...

Mais je ne sais pas comment inscrire cette suite de caractère dans la ligne
Pouvez-vous m'aidez

 

[youky(BJ)]

Yes,
2 solutions soit:
If .Cells(lig, 1) = "VA" or .Cells(lig, 1) = "CL" or .Cells(lig, 1) = "EC" Then

ou bien si beaucoup de tests

'le début de la macro ici.....et
truc = Array("", "VA", "CL", "EC", "MA")
For lig = 4 To bas
For n=1 to 4 'nbre de trucs
If .Cells(lig, 1) = truc(n) then
'copie que des valeurs
Range("B" & i & ":H" & i).Value = .Range("A" & lig & ":G" & lig).Value
i = i + 1
End If
Next n
Next lig
End With
Wb.Close 'ferme le fichier
End if
End if

Par contre je sais pas comment mettre RESOLU
Bruno

 

[cathodique]

Bonjour,

Par contre je sais pas comment mettre RESOLU

Tu vas à ton 1er message, sous le titre vers la droite il y a une toupie "outil", tu cliques dessus et tu choisis "modifier le titre" - tu rajoutes au titre Résolu.

 

[Kirua27]

Ok merci de tes réponses rapide est forte utiles, sa fonctionne, parfaitement. Là je peux passer en résolu🙂