Aide pour modifier une macro automatique

[creolia]

bonsoir à tous j’espère tout le monde se porte bien

voila j'ai cette macro que j'utilise pour activer un classeur excel ouvert copier les donner et les coller dans un classeur qui s’appelle creer feuille de garde.

Sub CopiePlanning()

'ActionCopie.EFFACE

    Range("B1:N1").Select
    'On Error Resume Next
    For x = 1 To 254
    On Error Resume Next
    Windows("[COLOR="#FF0000"]804_mois.csv[/COLOR]").Activate
    Windows("804_mois-2.csv").Activate
    Range("A2:AG2743").Select
    Selection.Copy
    Next
    Windows("creer feuille Garde.xlsm").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C9").Select
    Windows("804_mois-2.csv").Close
    
    MsgBox "Copie effectuer"
    
End Sub

mon soucis est que le classeur source peut s'appeler autant

804_mois.csv
804_mois-1.csv
804_mois-2.csv
.......
804_mois-254.csv

J'ai essayer une boucle mais sa semble pas fonctionner
comment créer une boucle qui me recherche le bon classeur ouvert et faire la copie merci d'avance

 

[ERIC S]

Re : Aide pour modifier une macro automatique

Bonjour

sans exemple c'est toujours plus compliqué. Regarder peut-être :

nomfich=""
for i = 1 to windows.count
if left(windows(i).caption,8) = "804_mois" then nomfich=windows(i).caption
exit for
next
'
if nomfich="" then msgbox "pas de fichier ouvert - abandon":exit sub
windows(nomfich).activate

 

[creolia]

Re : Aide pour modifier une macro automatique

Bonjour Eric alors et merci pour ton aide après teste j'ai toujours fichier non trouver
j'ai fais un exemple type
merci pour ton aide

 

[ERIC S]

Re : Aide pour modifier une macro automatique

Re

à tester

Sub Bouton1_Cliquer()


'ActionCopie.EFFACE
nomfichier = ActiveWindow.Caption
    Range("B1:N1").Select
    'On Error Resume Next
    nomfich = ""
For i = 1 To Windows.Count
If LCase(Left(Windows(i).Caption, 8)) = "804_mois" Then nomfich = Windows(i).Caption: Exit For
Next
'
If nomfich = "" Then MsgBox "pas de fichier ouvert - abandon": Exit Sub

Windows(nomfich).Activate
Range("A4:B8").Copy

Windows(nomfichier).Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("C9").Select
Windows(nomfich).Close savechanges:=False
    
MsgBox "Copie effectuée"
    
End Sub

le exit for était mal placé
la casse est importante (majuscules minuscules), lcase() transforme en minuscule

 

[creolia]

Re : Aide pour modifier une macro automatique

Bonjour Eric s merci pour ton bout de code sa fonctionne parfaitement un grand merci à trés bientot