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

[piga25]

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

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

 

[Ikito]

Bonjour,

.Sheets(WBKSource.ActiveSheet.Name).Columns("A:D").Copy Before:=ThisWorkbook.ActiveSheet.Range("BL1") 'ligne qui pose problème

Ca marcherait pas ça ?

 

[piga25]

Bonjour Ikito,

Désolé mais cela ne reconnait pas le nom de la feuille.
Je pense qu'il faudrait nommer cette variable au début de la procédure, sachant que sur chaque feuille concernée il y a un bouton pour lancer la macro.

 

[piga25]

Bonjour Ikito, le forum

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

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]

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 :

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