SUPER RESOLU - Macro qui fonctionne trop bien

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Encore un problème que je ne parviens pas à résoudre malgré mes recherches.
Besoin de votre aide,

Voici mon soucis :
J'ai adapté une macro que vous avez eu la gentillesse de me concocter :

Code:
Sub TransmissionRdV()
'
' TransmissionRdV Macro
'

'
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    For i = 1 To 40
    Sheets("RdV agent").Select
    Range("A3").Select
    ActiveCell.FormulaR1C1 = i
    Call suivRdVagent
    ActiveSheet.Unprotect Password:="mdp"
    
    Sheets("RdV agent").Copy
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete
    Selection.Cut
    
    Range("B1:C1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[2]C[-1]=0,"""",CONCATENATE(LOOKUP(R[2]C[-1],Clients),"" "",LOOKUP(R[2]C[-1],Clients1)))"
    Range("B1:C1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Dim nom As String
    nom = Range("A3") & "-" & Range("B1") & "-" & Format(Date, "ddmmyyyy") & ".xls"
    ChDir _
        "C:\Users\bellivier.l\Desktop\Facturation\Agents RdV transmis\"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\bellivier.l\Desktop\Facturation\Agents RdV transmis\" & Range("A3") & "-" & Range("B1") & "-" & Format(Date, "ddmmyyyy") & ".xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    rep = MsgBox("Votre fichier est sauvegardé sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
    
    ActiveWindow.Close
    ActiveSheet.Protect Password:="mdp", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Next i
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Elle fonctionne super bien ..... trop bien même

En effet, elle me créé des classeurs consciencieusement de 1 à 40 comme demandé en début de code : For i = 1 To 40

Mais voilà, dans ma feuille "Données", là où la macro va chercher les numéros de 1 à 40, mes numéros clients ne se suivent pas et j'ai besoin que seuls les numéros existants soient traités.

Par exemple, dans cette feuille "donnée", seuls les numéros 1 8 9 etc. sont existants et ça peut changer.

Pourriez-vous m'aider ? (j'exécute la macro à partir de la feuille "RdV agent"

Je joins un fichier test, en cas de besoin, le mot de passe est mdp.

Avec un grand merci, je vous souhaite une bonne journée et un beau WE :)
Amicalement,
caliméro,
 

Pièces jointes

  • Test forum.xlsm
    279.3 KB · Affichages: 35
  • Test forum.xlsm
    279.3 KB · Affichages: 42
  • Test forum.xlsm
    279.3 KB · Affichages: 44
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : Macro qui fonctionne trop bien

Re bonjour à toutes et à tous,

J'ai trouvé ce code : Ce lien n'existe plus
Code:
Sub Save_2007_WorkSheet_As_97_2003_Workbook()
' Avoid the CheckCompatibility dialog when you copy a worksheet
' from an Excel 2007 or Excel 2010 file format with compatibility issues to a new
' workbook and save this workbook as an Excel 97 through Excel 2003 workbook.
    Dim Destwb As Workbook
    Dim SaveFormat As Long
    Dim TempFilePath As String
    Dim TempFileName As String

    ' Remember the users setting.
    SaveFormat = Application.DefaultSaveFormat
    ' Set the default format to the Excel 97 through Excel 2003 file format.
    Application.DefaultSaveFormat = 56

' You can specify a worksheet other than the active sheet by
' using the following syntax: Sheets("Sheet5").Copy.
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    Destwb.CheckCompatibility = False

    ' Save the new workbook and close it.
    TempFilePath = Application.DefaultFilePath & "\"
    TempFileName = "Excel 97-2003 WorkBook " & Format(Now, "yyyy-mm-dd hh-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=56
        .Close SaveChanges:=False
    End With

    ' Set default save format back to the users setting.
    Application.DefaultSaveFormat = SaveFormat
    
    MsgBox "You can find the file in " & Application.DefaultFilePath
    
End Sub

Mais il fonctionne pour sauvegarder 2007 vers 97/2003 mais pas 210 vers 97/2003

Je continue mes recherche ..... à moins que ce code puisse être modifié,

Bon WE à toutes et à tous
Amicalement,
Calimero,
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Macro qui fonctionne trop bien

Bonjour à tous

Pourtant on peut lire dans le commentaire.
' Avoid the CheckCompatibility dialog when you copy a worksheet
' from an Excel 2007 or Excel 2010 file format with compatibility issues to a new
' workbook and save this workbook as an Excel 97 through Excel 2003 workbook.

PS: arthour973:
Ça mange pas de main (et ça peut nourrir la curiosité) de citer la source :rolleyes:
Ce lien n'existe plus
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
321
Réponses
14
Affichages
1 K

Statistiques des forums

Discussions
312 198
Messages
2 086 134
Membres
103 129
dernier inscrit
Atruc81500