XL 2016 Ouvre un fichier sur une feuille et copie une plage sur le fichier destination

piga25

XLDnaute Barbatruc
Bonjour,

J'ai deux fichiers classement individuel et classement équipe.
Comme les noms et les emplacements de ces fichiers peuvent changer de place, il me faut un code qui permet d'ouvrir le fichier équipe à partir du fichier individuel.
Jusque là, cela va, mon code arrive à la faire.
Par contre ou j'ai un problème c'est dans le choix de la feuille, le nom doit être variable dans le code. Les deux fichiers ont exactement les même noms de feuille.
Donc si je suis sur la feuille ED du fichier individuel il faut que cela ouvre la feuille ED du fichier équipe. Les feuilles qui seront concernées sont: ED - EH - FD - FH - SD - SH
Et ensuite que cela copie les colonnes A, B, C et D (du fichier équipe) sur le fichier Individuel à partir de la cellule BL1

VB:
Sub copie_Classement_equipe()
Dim nom$, WBKSource As Workbook
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Choisissez le fichier"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom)
            With WBKSource
                .Sheets("ED").Columns("A:D").Copy Before:=ThisWorkbook.Sheets("ED").Range("BL1") 'ligne qui pose problème
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
End Sub
 

piga25

XLDnaute Barbatruc
Bonjour Ikito, le forum

J'ai modifié un peu la ligne mais j'ai maintenant une erreur : Indice hors limites (erreur9)

VB:
Sub copie_Classement_equipe()
Dim nom$, feuille$, WBKSource As Workbook
feuille = ActiveSheet.Name
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Choisissez le fichier"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom)
            With WBKSource
                .Sheets("Feuille").Columns("A:D").Copy Before:=ThisWorkbook.Sheets("feuille").Range("BL1") 'ligne qui pose problème
                .Close False
            End With
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
End Sub

Est ce que c'est la plage origine ou destination qui pose problème ?
 

piga25

XLDnaute Barbatruc
Bonjour le forum,
Je pense que le problème provient de la plage d'origine, elle doit être mal nommée dans le code.

Je mets les fichiers exemple pour plus de compréhension. Ici je dois copier uniquement le texte (sans formule ni mise en forme) du fichier Origine dans destination et cela pour que se soit valable pour chaque page

Après recherches, voici un code qui fonctionne :
VB:
Sub test()
Dim classeurSource As Workbook, classeurDestination As Workbook, feuille$
'Choix de la feuille à traiter
feuille = ActiveSheet.Name
'Choix du fichier source à ouvrir
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Choisissez le fichier"
    .Filters.Clear
    .Filters.Add "Fichier Excel", "*.xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
'ouvrir le classeur source (en lecture seule)
Set classeurSource = Application.Workbooks.Open(nom, , True)
'définir le classeur destination
Set classeurDestination = ThisWorkbook
'copier les données de la "Feuille" du classeur source vers la "Feuille" du classeur destination
classeurSource.Sheets(feuille).Range("A2:D20").Copy
classeurDestination.Sheets(feuille).Range("H5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Range("A18").Select
'fermer le classeur source
classeurSource.Close False
        Else
        MsgBox "Aucun fichier n'a été sélectionné", , "Erreur": Exit Sub
        End If
End With
Calculate
End Sub
 

Pièces jointes

  • Destination.xlsm
    24.5 KB · Affichages: 4
  • Origine.xlsm
    17.3 KB · Affichages: 3
Dernière édition:

Discussions similaires

Réponses
1
Affichages
269
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal