enregistrement de classeur Résolu/Fermé

Question

bonjour 
voici mon code

sub essai()

Workbooks.Open ("C:\VBAPointeuse\porte101214.xlsx")

'Compare la colonne H ET D
Derligne = Range("D1").End(xlDown).Row
Derligne1 = Range("H1").End(xlDown).Row
For I = 1 To Derligne
For j = 2 To Derligne1
If Range("H" & j).Value = Range("D" & I).Value Then 'si il trouve une corespondance alors il sauvegarde
Application.DisplayAlerts = False
 ActiveWorkbook.SaveAs Filename:="c:\VBAPointeuse" & "\" & Range("H" & j).Offset(0, -2).Value & Range("H" & j).Offset(0, -1).Value & (".xlsx")

End If
Next j
Next I
End Sub


mon souci c'est que l'enregistrement de mon classeur enregistre la feuille active du classeur porte101214
moi j'aimerais enregistrer un classeur vierge avec le nom de la cellule  Range("H" & j).Offset(0, -2).Value & Range("H" & j).Offset(0, -1).Value 
je ne sais plus comment faire

EDIT : Ajout des balises de code.
Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

jordane45 · Answer

Bonjour,
Pour créer une copie de la feuille dans un nouveau classeur tu peux faire

EDIT : Code Faux supprimé.
Voir réponse dans le message : https://forums.commentcamarche.net/forum/affich-31588907-enregistrement-de-classeur#5


Cordialement, 
Jordane

philh2008 · Answer

il memarque l'erreur suivante

la méthode'saveas'de l'objet'_workbook à échoué
ca c'est dès que je rajoute la ligne workbooks.add
il prend le nouveau classeur comme classeur actif donc il ne trouve plus la cellule demander

jordane45 · Answer

Voilou :

Sub essai()

Dim Derligne As Double
Dim Derligne1 As Double
Dim Wkbporte As Workbook
Dim Shporte As Worksheet

Dim clstest As String
clstest = "c:	mp\Classeur2.xlsx"
 Workbooks.Open (clstest)
Set Wkbporte = ActiveWorkbook
Set Shporte = Wkbporte.ActiveSheet
'Set Wkbporte = Workbooks.Open("C:\VBAPointeuse\porte101214.xlsx")

'Compare la colonne H ET D
Derligne = Shporte.Range("D1").End(xlDown).Row
Derligne1 = Shporte.Range("H1").End(xlDown).Row
For I = 1 To Derligne
    For j = 2 To Derligne1
         'si il trouve une corespondance alors il sauvegarde
        If Shporte.Range("H" & j).Value = Shporte.Range("D" & I).Value Then
            Application.DisplayAlerts = False
            'ajout d'un nouveau classeur
            Workbooks.Add
            'sauvegarde du nouveau classeur
            ActiveWorkbook.SaveAs _
            Filename:="c:\VBAPointeuse" & "" & _
                       Shporte.Range("H" & j).Offset(0, -2).Value & _
                       Shporte.Range("H" & j).Offset(0, -1).Value & _
                       ".xlsx"
        End If
    Next j
Next I
End Sub

philh2008 · Answer

voila j'ai modifier le code et cela fonctionne


Sub nouveauclasseur()

Workbooks.Open ("C:\VBAPointeuse\porte101214.xlsx")

'Compare la colonne H ET D
 
Derligne = Range("D1").End(xlDown).Row
Derligne1 = Range("H1").End(xlDown).Row

For I = 1 To Derligne
For j = 2 To Derligne1
'si on trouve une corespondance alors on enregiste
If Range("H" & j).Value = Range("D" & I).Value Then

Application.DisplayAlerts = False

 ActiveWorkbook.SaveAs Filename:="c:\VBAPointeuse" & "\" & Range("H" & j).Offset(0, -2).Value & Range("H" & j).Offset(0, -1).Value & (".xlsx")
 
  'si le fichier existe on l'ouvre
' ElseIf Dir("c:\VBAPointeuse" & "\" & Range("H" & j).Offset(0, -2).Value & Range("H" & j).Offset(0, -1).Value & (".xlsx")) <> "" Then
 ' Workbooks.Open Filename:="c:\VBAPointeuse" & "\" & Range("H" & j).Offset(0, -2).Value & Range("H" & j).Offset(0, -1).Value & (".xlsx")
 ' Sheets.Add
 ' Sheets("porte101214").Delete

   
  End If
 Next j
Next I


End Sub

Enregistrement de classeur

4 réponses

Discussions similaires