Macro Copie/Sauvegarde sheet dans nouveau workbook avec path

Bonjour,

Comment allez-vous? Premièrement, je suis nouveau sur ce forum et aussi très très novice dans macro/VBA. J’ai un workbook qui contient plusieurs worksheet.

Je suis en mesure de faire la sélection et d’y faire une copie avec certains critère. ‘Premiere partie’

Maintenant, ce que je cherche est de faire la sauvegarde avec un nom spécifique dans une endroit spécifique (pathway). Le nom et l’endroit seront toujours uniques

Le nom unique se retrouve dans un autre worksheet soit (Results- Résultats) et dans cell U30.

Pour l’endroit, la sauvegarde doit se faire où le présent fichier, où se retrouve la macro, est sauvegardé

J’ai tenté de faire la macro dans la deuxième partie mais, ca ne fonctionne pas puisque je ne suis pas en mesure d’appliquer le nom du fichier qui se retrouve dans la cellule U30 provenant d’un autre workbook. Mentionné ici-haut.

Merci beaucoup a l'avance

Sub STORETEST()

‘premiere partie’

Sheets("STORE").Select

Sheets("STORE").Copy

Cells.Select

Range("C1").Activate

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.SmallScroll ToRight:=4

ActiveSheet.Range("$A$12:$U$17013").AutoFilter Field:=21, Criteria1:="Yes"

With ActiveWorkbook

.SaveAs filename:=ThisWorkbook.path & .Sheets(1).Name & ".xls"

.Close savechanges:=False

End With

End Sub

Bonjour et bienvenue sur le forum !

Je n'ai pas parfaitement compris. S'il s'agit de récupérer la valeur de U30, voici un premier essai :

Sub STORETEST()

nomunique = sheets("Results").range("U30").value 'nom unique
Sheets("STORE").Copy 'copie STORE dans nouveau classeur

with activeworkbook 'avec classeur actif (créé à l'instant)
    with activesheet 'avec feuille active copiée à l'instant
        .Range("C1").value = .range("C1").value 'on met C1 en valeur
        .Range("$A$12:$U$17013").AutoFilter Field:=21, Criteria1:="Yes" 'on filtre sur col21
    end with
    .Close savechanges:=true, filename:=ThisWorkbook.path & "\" & .Sheets(1).Name & " " & nomunique & ".xls" 'on sauve et ferme avec nom complet
End With

End Sub

J'ai rajouté un antislash après thisworkbook.path. Le reste est une adaptation de ce que j'ai compris du code de manière à la rendre plus lisible, avec ajout de nomunique.

Au fait, pour poster du code, vous pouvez utiliser les balises </> du ruban de commentaire

Cdlt,

Bonjour,

Merci beaucoup pour cette reponse tres rapide. Je sais que je peux etre difficile a me faire comprendre puisque je suis super debutant. Je vais essayer. J'ai aussi un autre un path way unique que je dois ajouter.

Dans votre formule, est-ce que je dois ajouter le path = Range ("U11") sous nomunique = sheets ("results")....?

Si oui, est-ce que je dois aussi utiliser nomunique ou je peux rendre path?

Merci beaucoup encore

Bonjour,

En effet, ce n'est pas évident à comprendre...

Ici, nomunique est juste une variable qui stocke une partie du nom. Son utilisation n'est pas nécessaire (elle permet de définir une partie du nom avant que le nouveau classeur ne soit créé et d'avoir une ligne d'enregistrement (ligne .close) pas trop longue.

Le path est l'emplacement du fichier, le répertoire (dossier) de destination. Le name est le nom du fichier et le filename est le chemin du fichier, le nom complet (path + nom).

Ici, si je comprends bien le path est en U11 et le name en U30 donc on va créer une variable sfilename qui sera la concaténation de ces 2 infos :

Sub STORETEST()

with sheets("Results")
    spath = .range("U11").value 'emplacement
    sname = .range("U30").value & ".xlsb" 'nom
    sfilename = spath & "\" & sname 'chemin complet
end with

Sheets("STORE").Copy 'copie STORE dans nouveau classeur

with activeworkbook 'avec classeur actif (créé à l'instant)
    with activesheet 'avec feuille active copiée à l'instant
        .Range("C1").value = .range("C1").value 'on met C1 en valeur
        .Range("$A$12:$U$17013").AutoFilter Field:=21, Criteria1:="Yes" 'on filtre sur col21
    end with
    .Close savechanges:=true, filename:=sfilename 'on sauve et ferme avec nom complet
End With

End Sub

Si en U11, la valeur termine par "\", on peut effacer le & "\" que j'ai rajouté au moment de l'affectation de sfilename.

Cdlt,

Allo,

Tu es super efficace dans tes retours. Mais, je suis désolé, ca bloque au début.

Si tu n'es plus interesser a repondre, je comprendrais.

Juste me dire, je passe. Au moins je vais le savoir

Merci

Salut,

Non, ne t'inquiète pas, pour l'instant ça va. C'est quand les demandes s'empilent que je me lasse mais on est sur le sujet de départ donc aucun souci .

Ici, l'erreur 9 indique que la feuille n'existe pas. En fait, il y a fort à parier qu'il y a un espace de fin (on le voit sur l'image). En général, il vaut mieux avoir des noms concis, sans accent ni caractères spéciaux ni espaces (si possible). Mais parfois on est obligé, je le sais bien.

Au cas où, tu peux résoudre ce problème d'espace indésirable sur tous tes onglets, si tu en as beaucoup, avec cette macro :

sub trimer()

for each ws in worksheets
ws.name = trim(ws.name)
next ws

end sub

En réessayant, tu devrais passer l'étape.

Cdlt,

Merci tres gentil de ta part

pour la nouvelle macro

J'ai essayé. Ca passe mais, un autre embuche. Je suis aller voir sur le net.

Je suis allé dans option / centre de gestion / parametre de gestion / parametre des macros et je suis aller coché acces approuvé

Conseil?

Merci

Non, je n'ai pas vriament d'idée, il peut y avoir plusieurs raisons. Le mieux serait que tu postes ton fichier tel qu'il est au moment du bug. Il faut donc déboger et le sauvegarder.

A bientôt,

Merci encore. J'ai essayé de regarder des videos sur le net mais, bon. Je n'arrive pas

Merci

Bonjour toutes et tous

coucoui 3Gb

@Eric, j'ai mis comme cela et cela à fonctionner pour la ligne jaune, si cela peut aider

    Worksheets("STORE").Range("$A$8").AutoFilter _
 Field:=21, _
 Criteria1:="Yes", _
 VisibleDropDown:=False

complet:

Sub STORECOPY()

With Sheets("Results")
    spath = .Range("H1").Value
    sname = .Range("H2").Value
    sfilename = spath & sname
End With

Sheets("STORE").Copy

    With ActiveSheet
        .Range("C1").Value = .Range("C1").Value
       ' .Range("$A$8:$U$17013").AutoFilter Field:=21, Criterial:="Yes"
    Worksheets("STORE").Range("$A$8").AutoFilter _
 Field:=21, _
 Criteria1:="Yes", _
 VisibleDropDown:=False

    End With

  With ActiveWorkbook
    .Close savechanges:=True, Filename:=sfilename
  End With

End Sub

Note1: pour la cellule H1 de la feuille results pour effectuer un test sur le bureau (Desktop)

C:\Users\MONIDENTIFIANT\Desktop\

Note2: de plus sur la ligne jaune .Range($A$12:... et cela commence en A8 et non en a12

crdlt,

André

Salut Andre !

Merci d'être intervenu et nous rejoindre !

@Eric : En effet, comme l'a souligné Andre, Le tableau commence en ligne 8. Je me dis même qu'il pourrait être mieux de créer un tableau structuré...

En tout cas, j'ai essayé la méthode .autofilter qui marche lorsqu'on rajoute le paramètre operator. La Ligne du bug serait à remplacer par :

.Range("$A$8:$U$17009").AutoFilter Field:=21, Criteria1:="Yes", Operator:=xlOr

J'imagine que la solution d'Andre fonctionne. En plus, il a remarqué que, sur le fichier joint, les nom et emplacement du nouveau fichier sont en H1 et H2 et a adapté le code en conséquence (sinon, il y aurait eu un autre bug) (Merci pour ta vigilance André !).

Avec le nouveau code, si le dossier existe bien, ça devrait aller !

Cdlt,

Wow. Merci a vous deux. Je vais essayer ceci ce soir lorsque mes gars feront dodo.

Allo. J'ai oublie de mentionner que le fichier que j'ai mis n'est pas celui officiel donc, lorsque j"ai fait le copie/paste. je n'ai pas faite la copie a partir de la bonne position qui est rangée 12 sur le fichier original.
Merci encore

Bonsoir,

Cette fois ce sera la bonne, enfin j'espère :).

Dans ce cas, il suffira d'adapter toutes les plages de ce code :

Sub STORETEST()

with sheets("Results")
    spath = .range("cellule_avec_emplacement").value 'emplacement <<<<<<<<<<<<<<<<<<<<<
    sname = .range("cellule_avec_nom").value & ".xlsb" 'nom <<<<<<<<<<<<<<<<<<<<<<<<<
    sfilename = spath & "\" & sname 'chemin complet
end with

Sheets("STORE").Copy 'copie STORE dans nouveau classeur

with activeworkbook 'avec classeur actif (créé à l'instant)
    with activesheet 'avec feuille active copiée à l'instant
        .Range("C1").value = .range("C1").value 'on met C1 en valeur
        .Range("plagetableau").AutoFilter Field:=21, Criteria1:="Yes", operator:=xlor <<<<<<<<<<<<<<<<<<
    end with
    .Close savechanges:=true, filename:=sfilename 'on sauve et ferme avec nom complet
End With

End Sub

Et bonne nuit à vos gars alors

Cdlt,

Bonjour André

Ca fonctionne. Par contre, j'ai beaucoup de formules donc, dans la macro original poche :) on peut y voir que je fait un copie / paste specialvalue puisque je veux qu'il ne reste plus de formule. J'envoi les resultats par courriel a des collegues. Comment je peux l'integrer dans votre formule

Merci a l'avance

Sheets("STORE").Select

Sheets("STORE").Copy

Cells.Select

Range("C1").Activate

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.SmallScroll ToRight:=4

ActiveSheet.Range("$A$12:$U$17013").AutoFilter Field:=21, Criteria1:="Yes"

With ActiveWorkbook

.SaveAs filename:=ThisWorkbook.path & .Sheets(1).Name & ".xls"

.Close savechanges:=False

@3gb

@andre13

Un gros merci. Sans vous, je n'y aurait pas arrivé
Merci