Copier/coler d'un classeur à l'autre via un userform
Bonjour à tous,
j'ai besoin de votre aide:
Dans mon fichier de suivi des devis/facture, je souhaite via un userform, qui me propose l'ensemble des fichiers se trouvant dans un dossier défini, intégrer (copier/coller valeur) une plage de cellules du fichier qui aura été sélectionné dans le userform. j'ai écris le code ci-dessous mais la macro bloqué sur la ligne "Set cs = Workbooks(.List(x))" je pense que le problème vient du fait que les fichiers sont fermés et que ce code fonctionne pour des fichiers qui sont ouverts. Pourriez-vous m'indiquer ce que je devrais changer dans le code ? j'ai chercher dans plusieurs post sur le forum mais je ne parviens pas à adapter mon code... Merci d'avance pour l'aide que vous pourrez m'apporter.
bonne journée
Private Sub UserForm_Initialize()
repertoire = "U:\test\"
nf = Dir(repertoire & "*.*") ' premier fichier
Do While nf <> ""
Me.ListBox1.AddItem nf
nf = Dir ' fichier suivant
Loop
End Sub
Private Sub OK_Click()
Application.ScreenUpdating = True
Sheets("Factures").Activate
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim x As Integer 'déclare la variable x (incrément)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os As Object 'déclare la variable os (Onglet Source)
Set cc = ThisWorkbook 'définit le classeur cible
Set oc = cc.Sheets("Factures") 'définit l'onglet cible
With Me.ListBox1 'prend en compte la ListBox1
For x = 0 To .ListCount - 1 'boucle sur tous les éléments de la ListBox1
If .Selected(x) = True Then 'condition : si l'élément est sélectionné
'définit la cellule de destination (A1 de l'onglet cible si A1 est vide, sinon la première cellule vide de la colonne A)
Set dest = IIf(oc.Range("B15") = "", oc.Range("B15"), oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
Set cs = Workbooks(.List(x)) 'définit le classeur source
Set os = cs.Sheets("Factures") 'définit l'onglet source
os.Range("B15:I50").Copy dest 'copie la plage des cellules éditées de l'onglet source et la copie dans dest
End If 'fin de la condition
Next x 'prochain élément séolectionné de la boucle
End With 'fin de la prise en compte de la ListBox1
Unload Me 'vide et ferme l'Userform
oc.Activate 'sélectionne l'onglet cible
End Sub
Bonjour Franswe, bonjour le forum,
C'est marrant que tu aies écrit ce code car il me parle grave ! C'était du temps où je ne mettais pas encore le nom des variables en majuscule...
Pour éviter le plantage, le code ci-dessous ouvre le classeur source puis le referme. Tu dois adapter la variable CH qui définie le chemin d'accès des classeurs à ouvrir :
Private Sub OK_Click()
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim x As Integer 'déclare la variable x (incrément)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os As Object 'déclare la variable os (Onglet Source)
Application.ScreenUpdating = False
Set cc = ThisWorkbook 'définit le classeur cible
CH = cc.Path & "\" 'définit le chemin d'accès du classeur source (à adapter, ici j'ai mis le même que celui du classeur clble)
Set oc = cc.Sheets("Factures") 'définit l'onglet cible
With Me.ListBox1 'prend en compte la ListBox1
For x = 0 To .ListCount - 1 'boucle sur tous les éléments de la ListBox1
If .Selected(x) = True Then 'condition : si l'élément est sélectionné
'définit la cellule de destination (A1 de l'onglet cible si A1 est vide, sinon la première cellule vide de la colonne A)
Set dest = IIf(oc.Range("B15") = "", oc.Range("B15"), oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
On Error Resume Next 'gestion des erreurs (en cas déereur oasse à la ligne suivante)
Set cs = Workbooks(.List(x)) 'définit le classeur source cs (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Workbooks.Open (CH & .List(x)) 'ouvre le classeur
Set cs = ActiveWorkbook 'définit le classeur source cs
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set os = cs.Sheets("Factures") 'définit l'onglet source
os.Range("B15:I50").Copy dest 'copie la plage des cellules éditées de l'onglet source et la copie dans dest
cs.Close False 'ferme le classeur source cs
End If 'fin de la condition
Next x 'prochain élément sélectionné de la boucle
End With 'fin de la prise en compte de la ListBox1
Unload Me 'vide et ferme l'Userform
Application.ScreenUpdating = True
oc.Activate 'sélectionne l'onglet cible
End SubMerci ThauTheme pour cette rapide réponse. En effet, j'ai récupérer ce code sur un forum. Merci de l'avoir écrit
je fais un test ce soir et je te reviens.
Encore merci.
franswe
Bonjour ThauTheme, Bonjour à tous,
j'ai intégré ton code dans mon fichier et je l'ai executé. je n'ai pas eu de message d'erreur mais cela ne fonctionne pas. les deux fichiers se ferment et le copier / collé ne se fait pas. je ne parviens pas à voir ou se situe le problème.
je ne sais pas si je suis clair ...
J'ai un répertoire U:\test\Devis\ ou sont sauvegardés tous mes devis. J'ai un fichier de suivi à partir du quel je créé les factures. je souhaite que via une listbox je puisse choisir le devis à transformer en facture et copier/coller le descriptif du devis (B15 à I50) dans les même cellules de l'onglet Factures de mon fichier de suivi.
Merci pour ton aide
bonne pm
Private Sub UserForm_Initialize()
repertoire = "U:\test\Devis\"
nf = Dir(repertoire & "*.*") ' premier fichier
Do While nf <> ""
Me.ListBox1.AddItem nf
nf = Dir ' fichier suivant
Loop
End Sub
Private Sub OK_Click()
Application.ScreenUpdating = True
Sheets("Factures").Activate
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim x As Integer 'déclare la variable x (incrément)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os As Object 'déclare la variable os (Onglet Source)
Application.ScreenUpdating = False
Set cc = ThisWorkbook 'définit le classeur cible
CH = cc.Path & "U:\test\Devis\" 'définit le chemin d'accès du classeur source (à adapter, ici j'ai mis le même que celui du classeur clble)
Set oc = cc.Sheets("Factures") 'définit l'onglet cible
With Me.ListBox1 'prend en compte la ListBox1
For x = 0 To .ListCount - 1 'boucle sur tous les éléments de la ListBox1
If .Selected(x) = True Then 'condition : si l'élément est sélectionné
'définit la cellule de destination (A1 de l'onglet cible si A1 est vide, sinon la première cellule vide de la colonne A)
Set dest = IIf(oc.Range("B15") = "", oc.Range("B15"), oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
On Error Resume Next 'gestion des erreurs (en cas déereur oasse à la ligne suivante)
Set cs = Workbooks(.List(x)) 'définit le classeur source cs (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Workbooks.Open (CH & .List(x)) 'ouvre le classeur
Set cs = ActiveWorkbook 'définit le classeur source cs
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set os = cs.Sheets("Devis") 'définit l'onglet source
os.Range("B15:I50").Copy dest 'copie la plage des cellules éditées de l'onglet source et la copie dans dest
cs.Close False 'ferme le classeur source cs
End If 'fin de la condition
Next x 'prochain élément sélectionné de la boucle
End With 'fin de la prise en compte de la ListBox1
Unload Me 'vide et ferme l'Userform
Application.ScreenUpdating = True
oc.Activate 'sélectionne l'onglet cible
End Sub