OUVERTURE FICHIER

a10

XLDnaute Impliqué
bonjour

comment faire une macro

2018 2 22
1 comment ouvrir un fichier 20180222 (avec comme variable LES données ci-dessus)

2 copier les données de la feuille

3 et les copier dans le classeur test

4 dans un onglet PAR EXEMPLE LE 22


a+
 

Lone-wolf

XLDnaute Barbatruc
Re

exemple.gif


Dans une feuille du classeur test liste les noms des classeurs à ouvrir. Dans la cellule A2 par exemple, crée une liste déroulante (Données > Validation de données > liste).

Dans ThisWorkbook

VB:
Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim wbSource As Workbook, wbDest As Workbook, fichier As String
Dim derlig As Long, cel As Range, tbl As Range, nom As String

  Application.ScreenUpdating = False
  Set wbDest = ThisWorkbook
  Set cel = wbDest.Sheets("Base").Range("a2")

  fichier = ThisWorkbook.Path & "\Fichiers source\" & cel.Value & ".xls"
  Set wbSource = Workbooks.Open(fichier)

  With wbSource.Sheets("Data")
  derlig = .Range("a" & Rows.Count).End(xlUp).Row
  Set tbl = .Range("a1:i" & derlig)
  End With

  Set Sh = wbDest.ActiveSheet
'Ici la feuille doit correspondre aux 2 derniers chiffres du classeur source
  nom = Right(cel.Value, 2)
  If Sh.Name = nom Then
  tbl.Copy Sh.Range("a1")
  Sh.Range("a:i").Columns.AutoFit
  Application.DisplayAlerts = False
  ActiveWorkbook.Close True
  ThisWorkbook.Save
  Else
  Application.DisplayAlerts = False
  ActiveWorkbook.Close True
  End If
End Sub

Ensuite sélectionne la feuille où tu veux copier les données.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

Une autre macro (à peaufiner)
NB: La macro est à mettre dans la classeur nommé test
VB:
Sub Test_a10()
Dim sFichier, a As Workbook, wb As Workbook, Nom$
Set a = ThisWorkbook
sFichier = Application.GetOpenFilename(Title:="Choisir votre fichier Excel", FileFilter:="Fichier Excel *.xls* (*.xls*),")
    If sFichier = False Then
        MsgBox "Aucun fichier choisi!.", vbExclamation, "Erreur"
        Exit Sub
        Else
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(sFichier)
    End If
Nom = Mid(wb.Name, InStrRev(wb.Name, ".") - 2, 2)
wb.Sheets(1).UsedRange.Copy
    With a.Sheets.Add(after:=a.Sheets(a.Sheets.Count))
        .Name = Nom: .Activate: .Paste
    End With
Application.CutCopyMode = False
wb.Close False
End Sub

EDITION: Bonjour Loup Solitaire ;)
 
Dernière édition:

Discussions similaires

Réponses
4
Affichages
665

Statistiques des forums

Discussions
311 729
Messages
2 081 966
Membres
101 852
dernier inscrit
dthi16088