Travailler sur 2 classeurs en même temps avec VBA

Bonjour,

Sur les conseils de LouReeD (membre de ce forum) je me permets de poster ma problématique ici:

J'ai un classeur source dans lequel j'ai plusieurs feuilles. J'aimerais pouvoir exporter des feuilles dans un autre classeur (classeur destination) qu'on viendrait ouvrir et sur lequel on viendrait travailler en parallèle.

Voici le code que j'aimerais développer:

Sub Exporter_feuille()
Dim Nom As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False

cheminfichier = Application.GetOpenFilename( _
    FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", _
    MultiSelect:=False)
    NomClasseurSource = ActiveWorkbook.Name
    If cheminfichier = "Faux" Then Exit Sub
    Workbooks.Open cheminfichier, 0, ReadOnly:=False

    NomClasseurDestination = ActiveWorkbook.Name

derniereLigne_source = Workbooks(NomClasseurSource).Sheets("JB").Range("C" & Rows.Count).End(xlUp).Row
derniereLigne_destination = Workbooks(NomClasseurDestination).Sheets("JB").Range("C" & Rows.Count).End(xlUp).Row

Workbooks(NomClasseurDestination).Sheets("JB").Select
Workbooks(NomClasseurDestination).Sheets("JB").Unprotect
Rows("8:" & derniereLigne_destination).Delete
Workbooks(NomClasseurSource).Sheets("JB").Select
Rows("8:" & derniereLigne_source).Copy
Workbooks(NomClasseurDestination).Sheets("JB").Select
Rows("8:8").Select
Selection.Insert Shift:=xlDown
Workbooks(NomClasseurDestination).Sheets("JB").Protect
    MsgBox "Export réalisé avec succès!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Voici ce que je souhaite faire:

1) Dans le classeur Destination, sur la feuille nommée "JB", on supprime les lignes à partir de la ligne 8 jusqu'à la dernière ligne non vide
2) Dans le classeur Source, sur la feuille nommée "JB", on copie les lignes de la ligne 8 jusqu'à la dernière ligne non vide
3) Dans le classeur Destination, sur la feuille nommée "JB", on sélectionne la ligne 8 et on vient insérer les lignes précédemment copiées en décalant tout le reste du classeur vers le bas.
4) On enregistre le classeur Destination
5) On ferme le classeur Destination sans demander de confirmation

J'imagine que la macro peut être optimisée/simplifiée sans les Select... mais je ne suis pas assez à l'aise avec VBA pour m'en sortir.

Merci aux membres qui pourront me venir en aide :)

Bonne soirée

JB

Bonjour JeanBaptisteP

Commencez déjà par définir vos variables objet et autre pour vous en servir

Option Explicit

Sub Exemple()
  ' Exemple de déclarations des variables objet et long
  Dim WbkS As Workbook, ShtS As Worksheet
  Dim dLigS As Long
  Dim WbkD As Workbook, ShtD As Worksheet
  Dim dLigD As Long
  ' Exemple de définition
  Set WbkS = Workbooks(NomClasseurSource)
  Set WbkD = Workbooks(NomClasseurDestination)
  Set ShtS = WbkS.Sheets("JB")
  Set ShtD = WbkD.Sheets("JB")
  ' Exemple d'utilisation
  dLigS = ShtS.Range("C" & Rows.Count).End(xlUp).Row
  dLigD = ShtD.Range("C" & Rows.Count).End(xlUp).Row
End Sub

A+

Bonsoir BrunoM45,

Merci pour vos précieux conseils. Étant débutant en VBA je ne vois pas comment adapter votre remarque à mon projet. J'essaye déjà de différencier les 2 classeurs par leur nom en affichant le résultat dans une Msgbox et je bloque. Auriez-vous une piste s'il vous plait ? :)

Sub Visualiser_noms_classeurs()
Dim NomClasseurSource As Workbook
Dim NomClasseurDestination As Workbook

cheminfichier = Application.GetOpenFilename( _
    FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", _
    MultiSelect:=False)
    NomClasseurSource = ActiveWorkbook.Name
    If cheminfichier = "Faux" Then Exit Sub
    Workbooks.Open cheminfichier, 0, ReadOnly:=False

    NomClasseurDestination = ActiveWorkbook.Name

MsgBox NomClasseurSource & NomClasseurDestination

End Sub

Bonne soirée

JB

J'ai compris mon erreur, autant pour moi.

En fait non, je bloque toujours...

Depuis un classeur EXCEL, j'ouvre via une boite de dialogue un autre classeur EXCEL et ensuite je veux revenir au 1er classeur EXCEL et là je bloque...

Voici mon code, auriez-vous une piste s'il vous plait ?

Sub Selection_classeur()
Dim wbs As Workbook

NomClasseurSource = ActiveWorkbook.Name
Set wbs = Workbooks(NomClasseurSource)

cheminfichier = Application.GetOpenFilename( _
    FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", _
    MultiSelect:=False)

    If cheminfichier = "Faux" Then Exit Sub
    Workbooks.Open cheminfichier, 0, ReadOnly:=False

    NomClasseurDestination = ActiveWorkbook.Name

'MsgBox NomClasseurSource & NomClasseurDestination
wbs.Worksheets("Feuil1").Select

End Sub

Merci à vous tous

JB

Bonjour JBP

Voici le code modifié et expliqué

Sub Selection_classeur()
  Dim Wbs As Workbook, Wbd As Workbook
  Dim CheminFichier As String
  ' Définir le classeur source
  Set Wbs = ThisWorkbook
  ' Demander à l'utilisateur le fichier à ouvrir
  CheminFichier = Application.GetOpenFilename( _
    FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", _
    MultiSelect:=False)
   ' Si demande annulée, sortir
    If CheminFichier = "Faux" Then GoTo FinSub
    ' Définir le classeur de destiantion
    Set Wbd = Workbooks.Open(CheminFichier, 0, ReadOnly:=False)
    ' Activer le classeur source
    Wbs.Activate
FinSub:
  ' Effacer les variable objet pour libérer la mémoire
  Set Wbs = Nothing: Set Wbd = Nothing
End Sub

Comme dit précédemment, rien ne sert de faire des Select, puisque qu'on peut travailler sur un objet directement

A+

Bonjour BrunoM45,

Merci pour votre retour. A partir du code que vous me proposez, comment écrire "TEST OK" dans la cellule A1 de la Feuil2 du classeur destination s'il vous plait ?

Wbd.Sheets("Feuil2").Range("A1").Value = "TEST OK"

J'ai essayé le code ci-dessus, en vain.

Je me servirai de votre exemple pour la suite de mon projet.

Merci beaucoup

JB

bonjour le fil,

si ce Wbd.Sheets("Feuil2").Range("A1").Value = "TEST OK" se trouve juste avant le "FinSub:", cela doit fonctionner, parce que quelque lignes plus tard Wbd est de nouveau "nothing". Voulez-vous changer ce A1 dans cette même macro ?

Bonjour BsAlv, le forum

Merci pour votre retour. J'ai changé ma stratégie et finalement je vais me résoudre à copier la feuille "TEST" du classeur ouvert et la coller sur le classeur que je viens ouvrir par la boite de dialogue. Voici mon code:

Sub Copie_feuille_classeur()
  Dim Wbs As Workbook, Wbd As Workbook
  Dim CheminFichier As String

  ' Définir le classeur source
  Set Wbs = ThisWorkbook
  ' Demander à l'utilisateur le fichier à ouvrir
  CheminFichier = Application.GetOpenFilename( _
    FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", _
    MultiSelect:=False)
   ' Si demande annulée, sortir
    If CheminFichier = "Faux" Then exit sub
    ' Définir le classeur de destiantion
    Set Wbd = Workbooks.Open(CheminFichier, 0, ReadOnly:=False)

Workbooks.Open CheminFichier, 0, ReadOnly:=False
    NomClasseurDestination = ActiveWorkbook.Name
    Wbs.Sheets("Test").Copy after:= Wbd.Sheets(ActiveWorkbook.Worksheets.Count)
End Sub

Le problème c'est que après avoir collé la feuille dans le classeur destination, les liaisons se retrouvent modifiées. Comment procéder pour les rompre avec l'ancien classeur et les réaffecter au classeur destination ? (la feuille contient des liens vers d'autres feuilles, formules et graph)

Merci beaucoup pour votre aide

JB

Bonsoir JBP

Un joli mélimélo

Essaye ceci

Sub Copie_feuille_classeur()
  Dim Wbs As Workbook, Wbd As Workbook
  Dim WsD As Worksheet
  Dim CheminFichier As String
  ' Définir le classeur source
  Set Wbs = ThisWorkbook
  ' Demander à l'utilisateur le fichier à ouvrir
  CheminFichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xlsm*), *.xlsm*", _
    Title:="Choisissez un fichier Excel à ouvrir", MultiSelect:=False)
  ' Si demande annulée, sortir
  If CheminFichier = "Faux" Then Exit Sub
  ' Définir le classeur de destination
  Set Wbd = Workbooks.Open(CheminFichier, 0, ReadOnly:=False)
  ' Ajouter une feuille dans le classeur
  Set WsD = Wbd.Sheets.Add(After:=Wbd.Sheets.Count)
  ' Copier la feuille "Test" de ce classeur
  Wbs.Sheets("Test").Copy
  ' Coller les valeurs
  WsD.Range("A1").PasteSpecial xlPasteValues
  ' les formats
  WsD.Range("A1").PasteSpecial xlPasteFormats
End Sub

A+