Publi et enregistrement Excel

Bonjour

J'ai une feuille1 qui comporte un tableau complet, la feuille19 seulement les éléments comportant un même nom. Avec la feuille 2 j'aimerai créer une fiche (feuille13) seulement si la colonne 15 ne contient pas OK, via un code VBA mais que ces fiches soient enregistrées en créant un répertoire du même nom que cellule précise (exemple : cellule F1 de la feuille 2 = TOTO - création d'un répertoire TOTO et la feuille est enregistrée sous le nom TOTO dans le répertoire TOTO).

J'ai bien un code mais ça coince !!

Merci d'avance pour votre aide

Sub publi()

Dim i, j As Integer

Dim nblig, debut, fin, lig_dest As Integer

Dim Num, Chemin As String

With Feuil19

Application.ScreenUpdating = False

If Cells(i, 15) = "" Then

For j = debut To fin

If j = debut Then

'coordonnées

aide = .Range("b" & j)

Feuil13.Range("f1") = .Range("b" & j)

Feuil13.Range("e2") = .Range("c" & j)

Feuil13.Range("e3") = .Range("d" & j)

End If

Next j

'enregistrement

Feuil13.Copy

Chemin = ActiveWorkbook.Path & "\" & Num

MkDir Chemin

ActiveWorkbook.SaveAs Chemin & ".xlsx" ' sauvegarde du fichier au format xls

Application.DisplayAlerts = False

ActiveWorkbook.Close False

Application.DisplayAlerts = True

Cells(i, 15) = "OK"

End If

Next

End With

End Sub

Bonjour,

Commence à déclarer toutes les variables

aide n'est pas déclaré, ainsi que i , nblig, debut, fin, num

il ne s'agit pas de les mettre bout à bout

exemple:

Dim i, as integer, j as integer etc, sinon il sont déclarés en Variant

i n'a pas de valeur

debut et fin n'a pas de valeur

il y a un Next à la fin sans For

Incrémente ton code, se sera plus facile à voir tes erreurs

Bonsoir M12,

Bonsoir le forum,

Voici mon code modifié ..... qui ne fonctionne pas plus d'ailleurs

Merci d'avance pour votre aide

KELLY

Sub publi()

Dim i, j As Integer

Dim nblig, debut, fin, lig_dest As Integer

Dim num, chemin As String

With Feuil19

Application.ScreenUpdating = False

.Columns(1).Copy .Columns(29)

.Range("b:b").Copy .Range("ac1")

'suppression des doublons

.Range("$ac:$ac").RemoveDuplicates Columns:=1, Header:=xlYes

If Cells(i, 15) = "" Then

debut = 2

For i = 2 To .Range("AC65536").End(xlUp).Row

nblig = Application.WorksheetFunction.CountIf(.Range("b:b"), .Range("ac" & i))

fin = debut + nblig - 1

For j = debut To fin

If j = debut Then

'coordonnées

num = .Range("b" & j)

Feuil2.Range("f1") = .Range("b" & j)

Feuil2.Range("e2") = .Range("c" & j)

Feuil2.Range("e3") = .Range("d" & j)

End If

Next j

'enregistrement

Feuil13.Copy

chemin = ActiveWorkbook.Path & "\" & num

MkDir Chemin

ActiveWorkbook.SaveAs chemin & num & ".xlsx" ' sauvegarde du fichier au format xls

Application.DisplayAlerts = False

ActiveWorkbook.Close False

Application.DisplayAlerts = True

Cells(i, 15) = "OK"

debut = fin + 1

efface

Next

'suppression de la colonne temporaire

.Range("AC:AC").Delete

End With

End Sub

Bonjour,

Je pense qu'il serait plus rapide que tu mettes un classeur exemple pour rédiger ton code

Sinon, une partie des erreurs sur le tien

Option Explicit 'Si une variable n'est pas déclarée, il te le fait savoir

Sub publi()
Dim i%, j%, nblig%, debut%, fin%, lig_dest% 'le "%" remplace le "As Integer"
Dim num$, chemin$ 'le "$" remplace "As String"
  With Feuil19
    Application.ScreenUpdating = False
    .Columns(1).Copy .Columns(29)
    .Range("b:b").Copy .Range("ac1")
    'suppression des doublons
    .Range("$ac:$ac").RemoveDuplicates Columns:=1, Header:=xlYes
    '***********************************************************
      If Cells(i, 15) = "" Then ' i vaut QUOI ?
                                ' Pas de END IF pour le IF
    '***********************************************************
        debut = 2
          For i = 2 To .Range("AC65536").End(xlUp).Row
            nblig = Application.WorksheetFunction.CountIf(.Range("b:b"), .Range("ac" & i))
            fin = debut + nblig - 1 'Comprend pas trop pourquoi la variable FIN ?
              For j = debut To fin
                If j = debut Then 'Comprend pas non plus, j est déclaré "=2" ---> debut = 2
                  'coordonnées
                  num = .Range("b" & j)
                  Feuil2.Range("f1") = .Range("b" & j) ' Nouvelle feuille ?
                  Feuil2.Range("e2") = .Range("c" & j)
                  Feuil2.Range("e3") = .Range("d" & j)
                End If
              Next j
            'enregistrement
            Feuil13.Copy 'Il n'y a rien à copier, puisqu'il n'y a rien d'ajouté
            chemin = ActiveWorkbook.Path & "\" & num
            MkDir chemin
            ActiveWorkbook.SaveAs chemin & num & ".xlsx" ' sauvegarde du fichier au format xls
            Application.DisplayAlerts = False
            ActiveWorkbook.Close False
            Application.DisplayAlerts = True
            Cells(i, 15) = "OK"
            debut = fin + 1
            efface 'Je suppose l'ouverture d'une autre macro
          Next
        'suppression de la colonne temporaire
        .Range("AC:AC").Delete
  End With
End Sub

Bonsoir M12,

Tout d'abord merci pour ton aide,

ci joint le fichier

Merci d'avance

KELLY

Bonjour,

A tester

Bonsoir M12

Un très grand merci ! C'est exactement ce que je voulais.

Merci encore !!!!!

KELLY