Bonjour à tous,
J'ai récupéré des fichiers excel avec macro que je souhaitais adapter.
Il s'agit de 2 fichiers : une interface de saisie (Formulaire.xls), qui va incrémenter une base de données située dans un autre fichier (base.xls).
Les informations sont saisie dans Formulaire.xls. Puis il y a un bouton "Valider" à la fin de la feuille, pour lancer la macro, remplir les lignes du tableau dans le fichier base.xls, et enregistrer la fiche remplie dans un dossier.
J'ai fais quelques modifs sur le fichier, mais juste des modifs de numéro de colonnes ou de lignes.
Lorsque je lance la macro, une fenêtre s'ouvre avec "ERREUR 400".
Suite à mes recherches sur les différents forums, j'ai testé :
Changement de nom de ma macro, changement de format des cellules de destination...
Le lancement pas à pas ne donne rien : l'erreur arrive dès le début...
Voici le code si besoin :
Sub valid()
Workbooks.Open "base.xls"
i = 4
While Workbooks("base.xls").Worksheets("bd").Cells(i, 1) <> ""
i = i + 1
Wend
Call copcol(i)
'Tronçon1
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("F6").Value <> "" Then
Call copcol(i)
Call infotronçon1
End If
'Tronçon2
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("G6").Value <> "" Then
Call copcol(i + 1)
Call infotronçon2
End If
'Tronçon3
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("H6").Value <> "" Then
Call copcol(i + 2)
Call infotronçon3
End If
'Tronçon4
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("I6").Value <> "" Then
Call copcol(i + 3)
Call infotronçon4
End If
'enregistrement & fermeture de base.xls
Workbooks("base.XLS").Close SaveChanges:=True
'enregistrement & archivage de la fiche
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
fName = Workbooks("Formulaire.xls").Worksheets("formulaire").Range("D2")
ChDir ".\Fiches IVP Archive"
ActiveWorkbook.SaveAs Filename:=fName
ActiveWorkbook.Close SaveChanges:=True
End Sub
Sub copcol(i)
'n° Fiche d'inspection
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("D2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Date
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("g2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Commune
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("d1").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 3).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Adresse
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("g1").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 4).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Agent
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("k2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 5).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'n° regard
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("f3").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 6).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub infotronçon1()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("F6:F49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon2()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("G6:G49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon3()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("H6:H49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon4()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("I6:I49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub effcontenu()
Range("K2,F3,F6:I11,F12:F17,F19:I19,F21:I48,B51:B54").Select
Selection.ClearContents
End Sub
Private Sub CommandButton1_Click()
End Sub
Merci beaucoup pour votre aide!
Mathilde
J'ai récupéré des fichiers excel avec macro que je souhaitais adapter.
Il s'agit de 2 fichiers : une interface de saisie (Formulaire.xls), qui va incrémenter une base de données située dans un autre fichier (base.xls).
Les informations sont saisie dans Formulaire.xls. Puis il y a un bouton "Valider" à la fin de la feuille, pour lancer la macro, remplir les lignes du tableau dans le fichier base.xls, et enregistrer la fiche remplie dans un dossier.
J'ai fais quelques modifs sur le fichier, mais juste des modifs de numéro de colonnes ou de lignes.
Lorsque je lance la macro, une fenêtre s'ouvre avec "ERREUR 400".
Suite à mes recherches sur les différents forums, j'ai testé :
Changement de nom de ma macro, changement de format des cellules de destination...
Le lancement pas à pas ne donne rien : l'erreur arrive dès le début...
Voici le code si besoin :
Sub valid()
Workbooks.Open "base.xls"
i = 4
While Workbooks("base.xls").Worksheets("bd").Cells(i, 1) <> ""
i = i + 1
Wend
Call copcol(i)
'Tronçon1
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("F6").Value <> "" Then
Call copcol(i)
Call infotronçon1
End If
'Tronçon2
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("G6").Value <> "" Then
Call copcol(i + 1)
Call infotronçon2
End If
'Tronçon3
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("H6").Value <> "" Then
Call copcol(i + 2)
Call infotronçon3
End If
'Tronçon4
If Workbooks("Formulaire.xls").Worksheets("formulaire").Range("I6").Value <> "" Then
Call copcol(i + 3)
Call infotronçon4
End If
'enregistrement & fermeture de base.xls
Workbooks("base.XLS").Close SaveChanges:=True
'enregistrement & archivage de la fiche
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
fName = Workbooks("Formulaire.xls").Worksheets("formulaire").Range("D2")
ChDir ".\Fiches IVP Archive"
ActiveWorkbook.SaveAs Filename:=fName
ActiveWorkbook.Close SaveChanges:=True
End Sub
Sub copcol(i)
'n° Fiche d'inspection
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("D2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Date
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("g2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Commune
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("d1").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 3).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Adresse
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("g1").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 4).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Agent
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("k2").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 5).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'n° regard
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("f3").Select
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Workbooks("base.xls").Worksheets("bd").Cells(i, 6).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub infotronçon1()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("F6:F49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon2()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("G6:G49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon3()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("H6:H49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub infotronçon4()
Workbooks("Formulaire.xls").Worksheets("formulaire").Activate
Range("I6:I49").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("base.xls").Worksheets("bd").Activate
Selection.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub effcontenu()
Range("K2,F3,F6:I11,F12:F17,F19:I19,F21:I48,B51:B54").Select
Selection.ClearContents
End Sub
Private Sub CommandButton1_Click()
End Sub
Merci beaucoup pour votre aide!
Mathilde