Problème avec if not isfileopen(valeur) then

Le 14/02/2023 à 18:14

Bonjour

je ne suis pas du tout un expert en programmation, j'ai fait qq recherches mais restées vaines. j'ai testé chatgpt, mais tout ne fonctionne pas (peut être heureusement :)...

l'idée est :

à partir d'une macro en VBA, copier la première ligne d'une feuille Excel et la coller dans un nouveau classeur. ensuite, rechercher dans le fichier initial les lignes dont le contenu de la premières cellule sont identiques, les coller dans le deuxième fichier à la suite de la 1ère ligne. Ne pas supprimer les doublons. Créer un nouveau fichier à chaque nouveauté et l'enregistrer avec le nom contenu dans la cellule A2.

mon problème : j'ai un message "erreur de compilation" sub ou function ne définie. (à la ligne "vérifier si le fichier a déjà été créé pour cette valeur")

merci pour votre aide.

macro :

Sub copiercoller()

Dim wb As Workbook
Dim ws As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim nom As String
Dim i As Long
Dim j As Long

'ouvrir le classeur actif
Set wb = ActiveWorkbook

'ouvrir la première feuille
Set ws = wb.Sheets(1)

'copier la première ligne
ws.Rows(1).Copy

'créer un nouveau classeur
Set wb2 = Workbooks.Add

'ouvrir la première feuille
Set ws2 = wb2.Sheets(1)

'coller la première ligne
ws2.Range("A1").PasteSpecial xlPasteAll

'trouver le dernier numéro de ligne de la première feuille
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

'parcourir chaque ligne de la première feuille
For i = 2 To lastRow

'récupérer la valeur de la première cellule de la ligne
valeur = ws.Cells(i, 1).Value

'vérifier si le fichier a déjà été créé pour cette valeur
If Not isFileOpen(valeur) Then

'créer un nouveau classeur avec le nom de la valeur
nom = ws.Cells(i, 2).Value
Set wb2 = Workbooks.Add
Set ws2 = wb2.Sheets(1)

'coller la première ligne
ws.Rows(1).Copy
ws2.Range("A1").PasteSpecial xlPasteAll

'sauvegarder le fichier
wb2.SaveAs nom

'fermer le fichier
wb2.Close
End If

'ouvrir le fichier correspondant à la valeur
Set wb2 = Workbooks.Open(ws.Cells(i, 2).Value)
Set ws2 = wb2.Sheets(1)

'trouver la dernière ligne
lastrow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

'coller la ligne à la suite
ws.Rows(i).Copy
ws2.Range("A" & lastrow2 + 1).PasteSpecial xlPasteAll

'fermer le fichier
wb2.Close
Next i

End Sub

Edit modo : merci de mettre le code entre balises SVP avec le bouton </>

Le 14/02/2023 à 18:25

Bonjour

Comme déjà signalé ici --> https://forum.excel-pratique.com/excel/inserer-une-ligne-incrementee-dans-un-tableau-defini-175442, mettez vos codes en utilisant les balises de code en cliquant sur l'icone </> dans la barre de menu.

Merci d'y faire attention SVP

Crdlt

Le 14/02/2023 à 19:02

Bonjour

re voila la macro en mode "plus lisible"

Sub copiercoller()

Dim wb As Workbook
Dim ws As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim nom As String
Dim i As Long
Dim j As Long

'ouvrir le classeur actif
Set wb = ActiveWorkbook

'ouvrir la première feuille
Set ws = wb.Sheets(1)

'copier la première ligne
ws.Rows(1).Copy

'créer un nouveau classeur
Set wb2 = Workbooks.Add

'ouvrir la première feuille
Set ws2 = wb2.Sheets(1)

'coller la première ligne
ws2.Range("A1").PasteSpecial xlPasteAll

'trouver le dernier numéro de ligne de la première feuille
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

'parcourir chaque ligne de la première feuille
For i = 2 To lastRow

'récupérer la valeur de la première cellule de la ligne
valeur = ws.Cells(i, 1).Value

'vérifier si le fichier a déjà été créé pour cette valeur
If Not isFileOpen(valeur) Then

    'créer un nouveau classeur avec le nom de la valeur
    nom = ws.Cells(i, 2).Value
    Set wb2 = Workbooks.Add
    Set ws2 = wb2.Sheets(1)

    'coller la première ligne
    ws.Rows(1).Copy
    ws2.Range("A1").PasteSpecial xlPasteAll

    'sauvegarder le fichier
    wb2.SaveAs nom

    'fermer le fichier
    wb2.Close
End If

'ouvrir le fichier correspondant à la valeur
Set wb2 = Workbooks.Open(ws.Cells(i, 2).Value)
Set ws2 = wb2.Sheets(1)

'trouver la dernière ligne
lastrow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

'coller la ligne à la suite
ws.Rows(i).Copy
ws2.Range("A" & lastrow2 + 1).PasteSpecial xlPasteAll

'fermer le fichier
wb2.Close
Next i

End Sub
Le 15/02/2023 à 00:34

Bonjour,

isFileOpen n'est pas une fonction vba mais une fonction personnalisée.
Il faut la rechercher (d'où tu la sors ?) et l'ajouter à ton projet.
eric

Le 15/02/2023 à 15:29

bonjour

c'est chapgpt qui me l'a donné

ca vaut ce que ca vaut mais ca sert de base. heureusement qu'il ne remplace pas l'homme...

Le 16/02/2023 à 01:09

Fait une recherche google dessus, tu vas trouver.

Rechercher des sujets similaires à "probleme isfileopen valeur then"