Autres Transfert des données d'un classeur à un autre

medlight

XLDnaute Junior
Bonjour à tous quelqu'un peut m'aider pour ces fichiers:
j'ai utilisé un code vba pour transférer les données du classeur source vers un autre classeur nommé à partir d'une cellule, le problème que je dois transferer les données des plusieurs feuilles.

Le code utilisé;

Option Explicit
Private Sub CommandButton1_Click()
Dim WshCb1 As Worksheet
Set WshCb1 = Workbooks(Me.[J7].Value & ".xlsx").Worksheets(1)
WshCb1.[B3:B7].Value = Me.[B3:B7].Value
WshCb1.[E6:E10].Value = Me.[E6:E10].Value
End Sub
 

Pièces jointes

  • 44-23-1724.xlsx
    9.3 KB · Affichages: 7
  • Source.xlsm
    20.7 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonsoir medlight, Bruno,

Le plus simple est de copier chaque feuille du fichier source :
VB:
Private Sub CommandButton1_Click()
Dim chemin$, n%, s As Object
chemin = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Open(chemin & Feuil1.[I7] & ".xlsx") 'ouvre le fichier
    For n = .Sheets.Count To 2 Step -1
        .Sheets(n).Delete
    Next n
    .Sheets(1).Name = Chr(1) 'nom provisoire
    For Each s In ThisWorkbook.Sheets
        s.Copy After:=.Sheets(.Sheets.Count) 'copie chaque feuille
        .Sheets(.Sheets.Count).DrawingObjects.Delete 'supprime les objets
    Next s
    .Sheets(1).Delete
    .Sheets(1).Select
    .Close True 'enregistre et ferme le fichier
End With
End Sub
Pour tester téléchargez les 2 fichiers dans le même dossier (le bureau).

A+
 

Pièces jointes

  • Source.xlsm
    23.8 KB · Affichages: 10
  • 44-23-1724.xlsx
    9.5 KB · Affichages: 5

Oneida

XLDnaute Impliqué
Bonjour a vous deux,

BrunoM45

Ce n'est pas copier les memes donnees aux memes endroits sur chaque feuilles du classeur cible

medlight

fonction des infos du fichier source
VB:
Private Sub CommandButton1_Click()
    Dim WshCbl As Worksheet
    Dim Wbk As Workbook
    Dim WshTB As Worksheet
    
    Set Wbk = ThisWorkbook
    Set WshTB = Wbk.Worksheets(1)
    Set WshCbl = Workbooks(Me.[I7].Value & ".xlsx").Worksheets("feuil1")
    
    With WshCbl
         .[B3:B7].Value = WshCbl.[B3:B7].Value
         .[E6:E10].Value = WshCbl.[E6:E10].Value
         .[C13].Value = WshCbl.[C13].Value
         .[E15].Value = WshCbl.[E15].Value
    End With
    Set WshTB = Wbk.Worksheets(2)
    Set WshCbl = Workbooks(Me.[I7].Value & ".xlsx").Worksheets("feuil2")
    With WshCbl
         .[F15:F17].Value = WshTB.[E12:E14].Value
         .[G9].Value = WshTB.[G8].Value
    End With
End Sub
 

Discussions similaires

Réponses
9
Affichages
139
Réponses
7
Affichages
476

Statistiques des forums

Discussions
313 197
Messages
2 096 109
Membres
106 500
dernier inscrit
mmontagu