Bonjour à toutes et à tous,
J'ai besoin de votre aide.
J'ai rédigé une macro qui est supposé :
Créer autant de nouvelle feuilles, à partir d'un modèle, dans un nouveau classeur, la feuille crée portant un nom créé à partir du contenu de 2 cellules.
Placer dans les feuilles créées, le contenu de cellules se trouvant dans un tableau excel (la ligne 2 contenant les données à recopier sur la première feuille, la ligne 3 sur la 2nde, et ainsi de suite).
Je ne parviens pas à trouver l'erreur dans la macro ci-dessous :
Merci beaucoup pour votre aide.
J'ai besoin de votre aide.
J'ai rédigé une macro qui est supposé :
Créer autant de nouvelle feuilles, à partir d'un modèle, dans un nouveau classeur, la feuille crée portant un nom créé à partir du contenu de 2 cellules.
Placer dans les feuilles créées, le contenu de cellules se trouvant dans un tableau excel (la ligne 2 contenant les données à recopier sur la première feuille, la ligne 3 sur la 2nde, et ainsi de suite).
Je ne parviens pas à trouver l'erreur dans la macro ci-dessous :
Code:
Option Explicit
'### Constantes à adapter (noms des feuilles source) ###
Const BASE As String = "Base"
Const MODEL As String = "model"
'#######################################################
Sub CreerCV()
Dim reponse
Dim bool As Boolean
Dim var1
Dim var2
Dim var3
Dim R As Range
Dim i&
Dim j&
Dim wbk As Workbook
Dim S As Worksheet
Dim Smod As Worksheet
Dim Sb As Worksheet
Dim Sf As Worksheet
Dim Sdest As Worksheet
Dim LastLig&
On Error GoTo PseudoErreur
Set Smod = Sheets(MODEL)
Set Sb = Sheets(BASE)
reponse = Application.InputBox(Prompt:="A compter de quel numéro de ligne doit-on créer les feuilles ?", Type:=1)
If reponse = False Or reponse = "" Then Exit Sub
LastLig& = Sb.Range("A65536").End(xlUp).Row
If reponse > LastLig& Then Exit Sub
reponse = CLng(reponse)
var1 = Sb.UsedRange
Application.ScreenUpdating = False
For i& = reponse To UBound(var1, 1)
If Not bool Then
Set wbk = Workbooks.Add(xlWBATWorksheet)
Smod.Visible = xlSheetVisible
Smod.Copy after:=wbk.Sheets(wbk.Sheets.Count)
Smod.Visible = xlSheetVeryHidden
Application.DisplayAlerts = False
wbk.Sheets(1).Delete
Set S = wbk.Sheets(1)
bool = True
End If
S.Copy after:=wbk.Sheets(wbk.Sheets.Count)
Set Sdest = wbk.Sheets(wbk.Sheets.Count)
Sdest.Name = var1(i&, 1) & " " & var1(i&, 2)
'--- Pour renseigner la feuille ---
Set R = Sdest.UsedRange
MsgBox (R)
var3 = R
var3(2, 1) = var1(i&, 1)
var3(3, 1) = var1(i&, 2)
var3(4, 1) = var1(i&, 3)
'var3(6, 1) = var1(i&, 5)
Next i&
S.Delete
PseudoErreur:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Err <> 0 Then MsgBox Err.Number & vbCrLf & Err.Description
End Sub
Merci beaucoup pour votre aide.