IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

sauvegarder une feuille et un .csv dans des nouveaux dossiers nommés avec variables [XL-2016]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Femme Profil pro
    Webdesigner
    Inscrit en
    Août 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Webdesigner
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Août 2018
    Messages : 7
    Points : 4
    Points
    4
    Par défaut sauvegarder une feuille et un .csv dans des nouveaux dossiers nommés avec variables
    Bonjour,
    pour ce code je me suis inspirée de plusieurs post de ce forum.
    J'ai un classeur A avec une sheet(1)
    Je dois copier et manipuler les datas de classeurA.sheet(1) pour créer un new classeurB.sheet(1) dans un sous dossier /variableA/ (crée si il n'existe pas), puis sauver classeurB.sheet(1) en format csv (idéalement .sof avec délimitateur ";") dans un sous dossier de /variableA/, soit /variableA/variableBetC/ (crée si il n'existe pas)

    J'ai réussi à tout faire mais en local dans le même dossier. Depuis que j'essaie de créer les dossiers et d'y mettre classeurB et fichier csv ça ne marche plus.

    L'idéal serait de faire ça en batch (multiples classeurs A à traiter) avec les classeurs fermés mais je n'en suis pas là.

    Voilà mon code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
        Dim nom As String
        Dim MonMM As String
        Dim MonYYYY As String
        Dim MonYY As String
        MonYY = Mid(Worksheets(1).Range("B2").Value, 7, 2)
        MonYYYY = Mid(Worksheets(1).Range("B2").Value, 5, 4)
        MonMM = Mid(Worksheets(1).Range("B2").Value, 1, 3)
        Select Case MonMM
        Case "JAN"
            MonMM = "01"
        Case "FEV"
            MonMM = "02"
        Case "MAR"
            MonMM = "03"
        Case "AVR"
            MonMM = "04"
        Case "MAI"
            MonMM = "05"
        Case "JUI"
            MonMM = "06"
        Case "JUL"
            MonMM = "07"
        Case "AOU"
            MonMM = "08"
        Case "SEP"
            MonMM = "09"
        Case "OCT"
            MonMM = "10"
        Case "NOV"
            MonMM = "11"
        Case Else
            MonMM = "12"
    End Select
     
    Application.ScreenUpdating = False
     
    Worksheets(1).Select
    ' test si 1re page est vide
    If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 0 And ActiveSheet.Shapes.Count = 0 Then
            MsgBox "La feuille est vide", vbInformation, "Jane prog. creation page CSV"
        Else
     'si 1re page n'est pas vide executer ce qui suit
     
    'définition du nom de la page 2 et remplissage des 2 lignes de tête de tableau
     
    Dim EDPEDK As String
        EDPEDK = ActiveWorkbook.Name
        MsgBox EDPEDK, vbInformation, "contenu variable"
        SendKeys String:="{enter}", Wait:=False
     
        nom = "VENPR767" & MonYY & MonMM & "00"
        'si la feuille klapotek existe la supprimer
     
        'ajoute la feuille klapotek
        Sheets.Add After:=Worksheets(1)
        Worksheets(2).Name = nom
     
    Worksheets(2).Cells(2, 1).Value = "Année/Mois"
    Worksheets(2).Cells(2, 2).Value = "Code Diffuseur"
    Worksheets(2).Cells(2, 3).Value = "Groupe Editeur"
    Worksheets(2).Cells(2, 4).Value = "Code Editeur"
    Worksheets(2).Cells(2, 5).Value = "Code Collection"
    Worksheets(2).Cells(2, 6).Value = "Collection"
    Worksheets(2).Cells(2, 7).Value = "Article"
    Worksheets(2).Cells(1, 8).Value = "1:France"
    Worksheets(2).Cells(2, 8).Value = "2:Export"
    Worksheets(2).Cells(2, 9).Value = "Auteur"
    Worksheets(2).Cells(2, 10).Value = "Titre"
    Worksheets(2).Cells(1, 11).Value = "Exemplaires"
    Worksheets(2).Cells(2, 11).Value = "Office"
    Worksheets(2).Cells(1, 12).Value = "Autres"
    Worksheets(2).Cells(2, 12).Value = "Vendus"
    Worksheets(2).Cells(2, 13).Value = "Retours"
    Worksheets(2).Cells(2, 14).Value = "Ventes Net"
    Worksheets(2).Cells(1, 15).Value = "Nb Lig"
    Worksheets(2).Cells(2, 15).Value = "Ventes"
    Worksheets(2).Cells(1, 16).Value = "Nb Lig"
    Worksheets(2).Cells(2, 16).Value = "Retours"
    Worksheets(2).Cells(1, 17).Value = "Nb Lig"
    Worksheets(2).Cells(2, 17).Value = "Rea."
    Worksheets(2).Cells(1, 18).Value = "Nb Cli"
    Worksheets(2).Cells(2, 18).Value = "Ventes"
    Worksheets(2).Cells(1, 19).Value = "Nb Cli"
    Worksheets(2).Cells(2, 19).Value = "Retours"
    Worksheets(2).Cells(2, 20).Value = "P.U."
    Worksheets(2).Cells(2, 21).Value = "Remise"
    Worksheets(2).Cells(2, 22).Value = "Brut HT"
    Worksheets(2).Cells(2, 23).Value = "Net Brut HT"
    Worksheets(2).Cells(2, 24).Value = "CodeEAN13"
     
    'calcul du nombre de lignes du tableau
    Dim lngLigne As Long
     
    Worksheets(1).Select
        lngLigne = 2
        Do While Range("D" & lngLigne).Value <> ""
            lngLigne = lngLigne + 1
        Loop
        'supprimer le dernier tour
        lngLigne = lngLigne - 1
        Range("D2:D" & lngLigne).Copy
        Worksheets(2).Select
        Range("X3").Select
        ActiveSheet.Paste
     
    'Copie de la colonne B en A
    Worksheets(1).Select
        Range("B2:B" & lngLigne).Copy
        Worksheets(2).Select
        Range("A3").Select
        ActiveSheet.Paste
        Range("A3").Select
        Range(Selection, Selection.End(xlDown)).Select
     
    'Changement colonne A avec code AAAAMM (ex : 201807)
        Dim cel As Range
     
        For Each cel In Selection
        cel = MonYYYY & MonMM
        Next cel
     
    'Copie de la colonne D en D (code EDP 767)
        Range("D3").Select
        ActiveSheet.Paste
        Range("D3").Select
        Range(Selection, Selection.End(xlDown)).Select
     
        For Each cel In Selection
        cel = 767
        Next cel
     
    'Copie de la colonne I en H plus changement France /Etranger en 00001/00002
    Worksheets(1).Select
        Range("I2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Worksheets(2).Select
        Range("H3").Select
        ActiveSheet.Paste
        Range("H3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).NumberFormat = "00000"
     
        For Each cel In Selection
        If cel = "France" Then
            cel = CStr("00001")
        Else
            cel = CStr("00002")
        End If
        Next cel
     
    'Copie de la colonne J en K
    Worksheets(1).Select
        Range("J2:J" & lngLigne).Copy
        Worksheets(2).Select
        Range("K3").Select
        ActiveSheet.Paste
     
    'Copie de la colonne K en L
    Worksheets(1).Select
        Range("K2:K" & lngLigne).Copy
        Worksheets(2).Select
        Range("L3").Select
        ActiveSheet.Paste
     
    'Copie de la colonne L en M
    Worksheets(1).Select
        Range("L2:L" & lngLigne).Copy
        Worksheets(2).Select
        Range("M3").Select
        ActiveSheet.Paste
     
    'Copie de la colonne M en N
    Worksheets(1).Select
        Range("M2:M" & lngLigne).Copy
        Worksheets(2).Select
        Range("N3").Select
        ActiveSheet.Paste
     
    'créer CSV
    Dim chemincsv As String
    chemincsv = nom & ".csv"
    'chemin du fichier
    Dim chemin As String, fichiercsv As String
    chemin = ThisWorkbook.Path
     
    'tester si les dossiers existent sinon les créer
    If Dir(chemin & "\KLAPOTEK\", 16) = "" Then
    MkDir (chemin & "\KLAPOTEK\")
    End If
    If Dir(chemin & "\KLAPOTEK\" & MonYYYY & MonMM, 16) = "" Then
    MkDir (chemin & "\KLAPOTEK\" & MonYYYY & MonMM)
    End If
     
     
    'créer classeur KLAPOTEK
     
    fichierKlapotek = chemin & "\KLAPOTEK\" & MonYYYY & MonMM & "\" & nom
     
      Worksheets(2).Copy
        'there is now a new active workbook
        Workbook.Add
        With ActiveWorkbook
            'save it
            .SaveAs Filename:=fichierKlapotek, FileFormat:=xlOpenXMLWorkbook
            'optionally close it
            .Close savechanges:=False
        End With
     
    'chemin et nom du fichier csv
    fichiercsv = chemin & "\KLAPOTEK\" & MonYYYY & MonMM & "\" & nom & ".csv"
     
    MsgBox fichiercsv, vbInformation, "Jane chemin du fichier .csv"
     
    Worksheets(2).Select
     
    'Créer fichier.csv
    Dim Plage As Object, oL As Object, oC As Object, Tmp As String, Sep$
    Sep = ";"
    Set Plage = ActiveSheet.Range("A1:X" & ActiveSheet.Range("X65000").End(3).Row)
    Open fichiercsv For Output As #1
    For Each oL In Plage.Rows
    Tmp = ""
    For Each oC In oL.Cells
    Tmp = Tmp & CStr(oC.Text) & Sep
    Next
    Print #1, Tmp
    Next
    Close
     
     
    End If 'fin des actions si Worksheets(1) n'est pas vide
     
     
     
    Application.ScreenUpdating = True
    Toute aide sera plus que bienvenue§
    Merci d'avance

  2. #2
    Membre averti
    Femme Profil pro
    Développeur informatique
    Inscrit en
    Septembre 2012
    Messages
    214
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Alpes Maritimes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Septembre 2012
    Messages : 214
    Points : 367
    Points
    367
    Par défaut
    Bonjour

    Ca plante ou ?

    tu peux faire un apres
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    fichierKlapotek = chemin & "\KLAPOTEK\" & MonYYYY & MonMM & "\" & nom
    que contient la variable ?

  3. #3
    Candidat au Club
    Femme Profil pro
    Webdesigner
    Inscrit en
    Août 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Webdesigner
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Août 2018
    Messages : 7
    Points : 4
    Points
    4
    Par défaut ca me crée bien les dossiers mais ne sauve pas les classeurs/fichire csv dedans
    En fait ca me crée bien les dossiers mais ne sauve pas les classeurs/fichire csv dedans. Ils ne sont plus sauvés...
    Çà me crée et ouvre un classeur sans nom avec ma worksheet (1) modifiée et l'onglet avec le bon nom. Mais ce classeur devrait être sauvé sous le nom de cet onglet et fermé.
    Çà ne met crée plus non plus le fichier csv.

    la MsgBox affiche : C:.............\KLAPOTEK\201807\VENPR20180700
    ce qui est exact. Faut-il à la fin?

  4. #4
    Membre averti
    Femme Profil pro
    Développeur informatique
    Inscrit en
    Septembre 2012
    Messages
    214
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Alpes Maritimes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Septembre 2012
    Messages : 214
    Points : 367
    Points
    367
    Par défaut
    oui

  5. #5
    Candidat au Club
    Femme Profil pro
    Webdesigner
    Inscrit en
    Août 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Webdesigner
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Août 2018
    Messages : 7
    Points : 4
    Points
    4
    Par défaut voilà le code qui fonctionne mais seulement s'il est dans le classeur sur lequel la macro agit
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
        Dim nom As String
        Dim MonMM As String
        Dim MonYYYY As String
        Dim MonYY As String
        MonYY = Mid(Worksheets(1).Range("B2").Value, 7, 2)
        MonYYYY = Mid(Worksheets(1).Range("B2").Value, 5, 4)
        MonMM = Mid(Worksheets(1).Range("B2").Value, 1, 3)
        Select Case MonMM
            Case "JAN"
                MonMM = "01"
            Case "FEV"
                MonMM = "02"
            Case "MAR"
                MonMM = "03"
            Case "AVR"
                MonMM = "04"
            Case "MAI"
                MonMM = "05"
            Case "JUI"
                MonMM = "06"
            Case "JUL"
                MonMM = "07"
            Case "AOU"
                MonMM = "08"
            Case "SEP"
                MonMM = "09"
            Case "OCT"
                MonMM = "10"
            Case "NOV"
                MonMM = "11"
            Case Else
                MonMM = "12"
        End Select
        'variable pour mois et année
        Dim AnMois As String
        AnMois = MonYYYY & MonMM
    Application.ScreenUpdating = False
     
    Worksheets(1).Select
        ' test si 1re page est vide
        If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 0 And ActiveSheet.Shapes.Count = 0 Then
                MsgBox "La feuille est vide", vbInformation, "Jane prog. creation page CSV"
        Else
    'si 1re page n'est pas vide executer ce qui suit
     
     'Définition du nom onglet et des classeurs
        nom = "VENPR767" & MonYY & MonMM & "00"
     
        'définition du nom et remplissage des 2 lignes de t^ete de tableau de la page 2
        Dim EDPEDK As String
        EDPEDK = ActiveWorkbook.Name
            MsgBox EDPEDK, vbInformation, "contenu variable"
     
        'tester si feuille existe déjà et la supprimer
            Dim ws As Worksheet
            For Each ws In Worksheets
              If ws.Name = nom Then
                ws.Delete
                Exit For
              End If
            Next ws
     
        'création d'une nouvelle feuille
            Sheets.Add After:=Worksheets(1)
            'nommer la feuille créée
            Worksheets(2).Name = nom
            'remplir la feuille créée avec manipulation des datas
            Worksheets(2).Cells(2, 1).Value = "Année/Mois"
            Worksheets(2).Cells(2, 2).Value = "Code Diffuseur"
            Worksheets(2).Cells(2, 3).Value = "Groupe Editeur"
            Worksheets(2).Cells(2, 4).Value = "Code Editeur"
            Worksheets(2).Cells(2, 5).Value = "Code Collection"
            Worksheets(2).Cells(2, 6).Value = "Collection"
            Worksheets(2).Cells(2, 7).Value = "Article"
            Worksheets(2).Cells(1, 8).Value = "1:France"
            Worksheets(2).Cells(2, 8).Value = "2:Export"
            Worksheets(2).Cells(2, 9).Value = "Auteur"
            Worksheets(2).Cells(2, 10).Value = "Titre"
            Worksheets(2).Cells(1, 11).Value = "Exemplaires"
            Worksheets(2).Cells(2, 11).Value = "Office"
            Worksheets(2).Cells(1, 12).Value = "Autres"
            Worksheets(2).Cells(2, 12).Value = "Vendus"
            Worksheets(2).Cells(2, 13).Value = "Retours"
            Worksheets(2).Cells(2, 14).Value = "Ventes Net"
            Worksheets(2).Cells(1, 15).Value = "Nb Lig"
            Worksheets(2).Cells(2, 15).Value = "Ventes"
            Worksheets(2).Cells(1, 16).Value = "Nb Lig"
            Worksheets(2).Cells(2, 16).Value = "Retours"
            Worksheets(2).Cells(1, 17).Value = "Nb Lig"
            Worksheets(2).Cells(2, 17).Value = "Rea."
            Worksheets(2).Cells(1, 18).Value = "Nb Cli"
            Worksheets(2).Cells(2, 18).Value = "Ventes"
            Worksheets(2).Cells(1, 19).Value = "Nb Cli"
            Worksheets(2).Cells(2, 19).Value = "Retours"
            Worksheets(2).Cells(2, 20).Value = "P.U."
            Worksheets(2).Cells(2, 21).Value = "Remise"
            Worksheets(2).Cells(2, 22).Value = "Brut HT"
            Worksheets(2).Cells(2, 23).Value = "Net Brut HT"
            Worksheets(2).Cells(2, 24).Value = "CodeEAN13"
     
        'calcul du nombre de lignes du tableau
        Dim lngLigne As Long
     
        Worksheets(1).Select
            lngLigne = 2
            Do While Range("D" & lngLigne).Value <> ""
                lngLigne = lngLigne + 1
            Loop
            'supprimer le dernier tour
            lngLigne = lngLigne - 1
            Range("D2:D" & lngLigne).Copy
            Worksheets(2).Select
            Range("X3").Select
            ActiveSheet.Paste
     
        'Copie de la colonne B en A
        Worksheets(1).Select
            Range("B2:B" & lngLigne).Copy
            Worksheets(2).Select
            Range("A3").Select
            ActiveSheet.Paste
            Range("A3").Select
            Range(Selection, Selection.End(xlDown)).Select
     
        'Changement colonne A avec code AAAAMM (ex : 201807)
            Dim cel As Range
     
            For Each cel In Selection
            cel = MonYYYY & MonMM
            Next cel
     
        'Copie de la colonne D en D (code EDP 767)
            Range("D3").Select
            ActiveSheet.Paste
            Range("D3").Select
            Range(Selection, Selection.End(xlDown)).Select
     
            For Each cel In Selection
            cel = 767
            Next cel
     
        'Copie de la colonne I en H plus changement France /Etranger en 00001/00002
        Worksheets(1).Select
            Range("I2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Worksheets(2).Select
            Range("H3").Select
            ActiveSheet.Paste
            Range("H3").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlDown)).NumberFormat = "00000"
     
            For Each cel In Selection
            If cel = "France" Then
                cel = CStr("00001")
            Else
                cel = CStr("00002")
            End If
            Next cel
     
        'Copie de la colonne J en K
        Worksheets(1).Select
            Range("J2:J" & lngLigne).Copy
            Worksheets(2).Select
            Range("K3").Select
            ActiveSheet.Paste
     
        'Copie de la colonne K en L
        Worksheets(1).Select
            Range("K2:K" & lngLigne).Copy
            Worksheets(2).Select
            Range("L3").Select
            ActiveSheet.Paste
     
        'Copie de la colonne L en M
        Worksheets(1).Select
            Range("L2:L" & lngLigne).Copy
            Worksheets(2).Select
            Range("M3").Select
            ActiveSheet.Paste
     
        'Copie de la colonne M en N
        Worksheets(1).Select
            Range("M2:M" & lngLigne).Copy
            Worksheets(2).Select
            Range("N3").Select
            ActiveSheet.Paste
     
    'déclaration des chemins
        Dim chemincsv, fichiercsv, fichierKlapotek As String
        chemincsv = nom & ".csv"
        'chemin du fichier
            Dim Chemin As String
            Chemin = ThisWorkbook.Path
            fichierKlapotek = Chemin & "\KLAPOTEK\" & AnMois & "\" & nom
            fichiercsv = Chemin & "\CSV\" & nom & ".sof"
     
        'test si le dossier existe
            Dim fso
            Dim folder As String
     
            folder = Chemin & "\KLAPOTEK"
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FolderExists(folder) Then
            Shell "Explorer.exe " & Chemin & "\KLAPOTEK"
            'MsgBox "dossier d'enregistrement existe"
            Else
            MkDir Chemin & "\KLAPOTEK"
            End If
     
            folder = Chemin & "\KLAPOTEK\" & AnMois 'AnMois ma variable
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FolderExists(folder) Then
            Shell "Explorer.exe " & Chemin & "\KLAPOTEK\" & AnMois
            'MsgBox "dossier d'enregistrement existe"
            Else
            MkDir Chemin & "\KLAPOTEK\" & AnMois
            End If
     
            folder = Chemin & "\CSV"
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FolderExists(folder) Then
            Shell "Explorer.exe " & Chemin & "\CSV"
            'MsgBox "dossier d'enregistrement existe"
            Else
            MkDir Chemin & "\CSV"
            End If
     
        'chemin et nom du fichier csv
     
        Worksheets(2).Select
     
    'Créer fichier.csv
        Dim Plage As Object, oL As Object, oC As Object, Tmp As String, Sep$
        Sep = ";"
        Set Plage = ActiveSheet.Range("A1:X" & ActiveSheet.Range("X65000").End(3).Row)
        Open fichiercsv For Output As #1
            For Each oL In Plage.Rows
            Tmp = ""
                For Each oC In oL.Cells
                Tmp = Tmp & CStr(oC.Text) & Sep
                Next
            Print #1, Tmp
            Next
        Close
     
        MsgBox fichiercsv, vbInformation, "Jane chemin du fichier .csv"
     
    'créer classeur KLAPOTEK
     
          Worksheets(2).Copy
            ' CheminKLA = "C:\Users\mini pc\Documents\EDP EXCEL\ESSAI\KLAPOTEK\" & AnMois
        With ActiveWorkbook
            'save it
            .SaveAs Filename:=fichierKlapotek, FileFormat:=xlOpenXMLWorkbook
            'optionally close it
            .Close savechanges:=False
        End With
     
        Worksheets(2).Delete
            '    'there is now a new active workbook
     
        MsgBox fichierKlapotek, vbInformation, "Jane chemin du fichier KLAPOTEK"
     
        End If 'fin des actions si Worksheets(1) n'est pas vide
     
    Application.ScreenUpdating = True

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Trier des valeurs dans une feuille et les mettre dans une autre feuille
    Par maharo1 dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 19/12/2011, 16h02
  2. Sauvegarder une feuille spécifique dans un nouveau classeur Excel
    Par thomasisajerk dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 20/08/2010, 12h12
  3. récupérer des informations d'une feuille et les placer dans une autre
    Par winclass dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 16/12/2008, 22h34
  4. Réponses: 7
    Dernier message: 25/09/2008, 15h51
  5. Réponses: 45
    Dernier message: 14/02/2008, 16h41

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo