XL 2013 Optimisation macro fait par un débutant

E

Etn

XLDnaute Occasionnel
Bonjour à tous !

Je débute plus ou moins dans excel et je n'y connais pas grand chose en VBA.
Du coup comme bon débutant qui se respecte, je fais pas mal de chose à l'aide de l'enregistreur de macro. Sauf que c'est quand même pas très beau, carrément pas optimisé, et pas très compréhensible.

Le principe (voir "classeur etn" ci-joint) est de copier les colonnes A,B et C de la feuille "extraction" vers la feuille BDD les unes à la suite des autres (c'est à faire tous les jours).
Je me sers donc du code suivant :

Code: 
Sheets("Extraction stock bilan").Select
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL1"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select

Alors certes c'est long, mais le problème c'est que je dois faire cela pour 5 feuilles du même classeur, donc j'ai recopié 4 fois de plus le code ci dessus en modifiant à chaque fois le nom de la feuille...

[SUITE DANS LE MESSAGE SUIVANT (trop long sinon...)]
 

Pièces jointes

  • classeur etn.xlsm
    57.8 KB · Affichages: 39
  • testetn.xlsx
    11.9 KB · Affichages: 35
Trier par date Trier par votes
E

Etn

XLDnaute Occasionnel
Code: 
Sub Transfer()
'
' Macro3 Macro
'


'
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL1"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select 'FIN FEUIL1
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL2"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select 'FIN FEUIL2
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL3"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select 'FIN FEUIL3
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL4"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select 'FIN FEUIL4
  Range("G6").Select
  ActiveCell.FormulaR1C1 = "FEUIL5"
  Range("G5").Select
  ActiveCell.FormulaR1C1 = _
  "=""testetn.xlsx"""
  Sheets("Extraction stock bilan").Select
  Range("A1:C250").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a4").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Sheets("Extraction stock bilan").Select
  Range("G5").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a2").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
  Selection.Copy
  Sheets("BDD stock bilan").Select
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  ActiveSheet.Range("a3").End(xlToRight).Offset(0, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("Extraction stock bilan").Select
  Range("G6").Select
 


End Sub


On va pas se mentir, ça doit être risible de voir ça quand on s'y connait un peu en excel...

Du coup je voulais savoir s'il n'était pas possible d'essayer d'optimiser cela (un dowhile peut être ?)


Si vous avez besoin de plus d'infos n'hésitez pas !


Merci d'avance pour votre aide,


Etn
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonsoir Etn

Un essai comme ceci, d'après ce que j'ai compris. Fait le test dans un nouveau classeur avant de l'adapter à ton fichier.

VB: 
Sub Transfert()
Application.ScreenUpdating = False
  With Feuil12
  .Range("G5") = "testetn.xlsx"
  .Range("G5").Copy Feuil2.Range("a2")
  For c = 2 To 15 Step 4
  x = x + 1
  .Range("G6") = "FEUIL" & x
  .Range("G6").Copy Feuil2.Cells(3, c)
  Feuil2.Cells(3, c).HorizontalAlignment = xlCenter
  Feuil2.Cells(3, c).Font.Bold = True
  Next c
  For col = 1 To 15 Step 4
  .Range("A1:C250").Copy Feuil2.Cells(4, col)
  Next col
  End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
E

Etn

XLDnaute Occasionnel
Bonjour Lone-Wolf,

Tout d'abord merci pour ton aide, j'ai essayé ta macro et je n'ai pas exactement ce que je recherche.

Tout d'abord les bons points sont que ta macro s'exécute bien plus rapidement que la mienne, et elle est bien plus courte (même si j'ai pas compris grand chose, j'arrive pas à voir ce que représente ce fameux "step 4").

Ensuite concernant les attentes, je souhaiterais qu'à chaque fois que l'on effectue la macro, les données transférées s'ajoutent à la suite des précédentes (voir classeur etnv2), et idéalement que le nom du fichier et le nom de la feuille se répètent pour chaque colonne (voir classeur etnv2).

Enfin je souhaiterais, si possible, que le nom des feuilles ne soit pas automatisé, cette fois ci ce sont FEUIL1, FEUIL2, etc. mais la prochaine fois cela peut être "ARTHUR", "LEA", "TOULOUSE", etc.

Etant donné qu'il n'y a pas beaucoup de feuille à chaque fois, est il possible de les inscrire manuellement dans la macro ? (ce n'est pas un problème si le nom des feuilles à importer sont directement dans la macro).

Je ne sais pas si j'ai été très clair, n'hésite pas si tu as besoin de plus de précisions.

Merci encore,

Etn
 

Pièces jointes

  • classeur etnv2.xlsm
    63.3 KB · Affichages: 33
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour Etn

Step 4 signifie qu'elle doit ajouter Feuil toutes les 4 colonnes.

Pour copier à la suite, il faut écrire comme ceci: .Range("G6").Copy Feuil2.Cells(3, c).End(xlUp)(2).

Et pour la dernierè demande: dans une colonne tu écrit les différents noms, dans la macro tu rajoute avant la ligne de copiage

derlig = .Range("az" & Rows.Count).end(xlUp).row
For k = 2 to derlig
.Range("G6") = .Range("az" & k)
next k

Bienentendu, fait un test avant pour cette dernière.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour à tous

Une simplification simplement pour la recopie
VB: 
Sub a()
'pour recopier
Sheets("Extraction stock bilan").Range("A1").CurrentRegion.Copy
Sheets("BDD Stock bilan").Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlValues
End Sub
 
Vote positif 0 Vote négatif
E

Etn

XLDnaute Occasionnel
Bonjour à tous,

@Lone-wolf : J'ai essayé en modifiant la macro, mais étant donné que je n'y connais pas grand chose j'ai pas réussi à l'adapter correctement je pense.

VB: 
Sub Transfert()
 Application.ScreenUpdating = False
  With Feuil12
  .Range("G5") = "testetn.xlsx"
  .Range("G5").Copy Feuil2.Range("a2")
  For c = 2 To 15 Step 4
  x = x + 1
  derlig = .Range("az" & Rows.Count).End(xlUp).Row
 For k = 2 To derlig
 .Range("G6") = .Range("az" & k)
 Next k
  .Range("G6").Copy Feuil2.Cells(3, c).End(xlUp)(2)
  Feuil2.Cells(3, c).HorizontalAlignment = xlCenter
  Feuil2.Cells(3, c).Font.Bold = True
  Next c
  For col = 1 To 15 Step 4
  .Range("A1:C250").Copy Feuil2.Cells(4, col)
  Next col
  End With
End Sub

Les données copiées ne s'ajoutent pas les unes à la suite des autres (corrigé avec la formule de Staple1600). De plus cela ne copie qu'une seule feuille (le premier nom inscrit dans la colonne AZ en général).

@Staple1600 : J'ai ajouté ta formule et cela copie bien les données, mais reste toujours le problème qu'il n'y a qu'une seule feuille lors de l'extraction et pas l'ensemble des feuilles mentionnées dans la colonne AZ.

VB: 
Sub Transfert()
 Application.ScreenUpdating = False
  With Feuil12
  .Range("G5") = "testetn.xlsx"
  .Range("G5").Copy Feuil2.Range("a2")
  For c = 2 To 15 Step 4
  x = x + 1
  derlig = .Range("az" & Rows.Count).End(xlUp).Row
 For k = 2 To derlig
 .Range("G6") = .Range("az" & k)
 Next k
  .Range("G6").Copy Feuil2.Cells(3, c).End(xlUp)(2)
  Feuil2.Cells(3, c).HorizontalAlignment = xlCenter
  Feuil2.Cells(3, c).Font.Bold = True
  Next c
  For col = 1 To 15 Step 4
  Sheets("Extraction stock bilan").Range("A1").CurrentRegion.Copy
 Sheets("BDD Stock bilan").Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlValues
  Next col
  End With
End Sub

Vous trouverez joint le résultat de l'extraction en utilisant la nouvelle macro.
 

Pièces jointes

  • Classeur etn v3.xlsm
    64.8 KB · Affichages: 32
  • testetn.xlsx
    12.1 KB · Affichages: 25
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re à tous

C'est mieux là ?
VB: 
Sub b()
Dim WB_SRC As Workbook, WB_DST As Workbook, X&, Y&
Set WB_SRC = Workbooks("testetn.xlsx")
Dim WS As Worksheet
For Each WS In WB_SRC.Worksheets
With Sheets("BDD Stock bilan")
X = .Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).Column
Y = WS.[A1].CurrentRegion.Columns.Count
.Cells(2, X).Resize(, Y) = WB_SRC.Name
.Cells(3, X).Resize(, Y) = WS.Name
WS.[A1].CurrentRegion.Copy
.Cells(4, X).PasteSpecial xlValues
End With
Next
End Sub
 
Vote positif 0 Vote négatif
E

Etn

XLDnaute Occasionnel
Re,

C'est exactement le résultat que j'attends, malheureusement le classeur d'où j'extrais les données doit être ouvert pour trouver les données, hors je souhaiterais faire une extraction sur un classeur fermé.
De plus cela copie tous les onglets du classeur, je souhaiterais que seul les onglets nommés (par exemple dans la colonne AZ) soient extrait et copiés.

Je vais quand même voir si je colle la 2e partie de ta macro à ma première partie si ça donne quelque chose.

Merci encore pour ton aide.

Etn
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Est-ce si grave d'ouvrir le classeur?
Si on peut l'ouvrir en VBA on peut aussi le fermer en VBA.
Si tu indiques les colonnes en G7, la bonne syntaxe c'est de séparer les colonnes par des virgules
VB: 
Sub TestColonnes()
'c'est simplement une macro de test
MsgBox Range(Replace([G7].Text, ";", ",")).Address
MsgBox Range(Replace([G7].Text, ";", ",")).SpecialCells(xlCellTypeConstants, 23).Address
End Sub

Sinon à quoi est censé servir le bouton Insérer un fichier ?
 
Dernière édition:
Vote positif 0 Vote négatif
E

Etn

XLDnaute Occasionnel
Re,

Le bouton sert au cas où on ne trouve pas le chemin du fichier désiré, rendant ainsi plus explicit la navigation aux utilisateurs pour trouver le fichier en question (la macro est dans la feuille). Ensuite on colle les colonnes dans la page, puis une fois qu'elles sont dans la feuille extraction on la copie colle dans la feuille BDD.

Sinon pourquoi pas l'ouvrir en VBA en effet, il faut que je rajoute une ligne du genre :
VB: 
Set WB = Workbooks.Open(Filename:=[COLOR=#ff0000]???[/COLOR], ReadOnly:=True, UpdateLinks:=0)
en déterminant le chemin en G4, le nom du fichier en G5 et la feuille en G6, c'est bien ça ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re à tous

Ci-dessous exemple pour choisir un fichier
VB: 
Sub c()
Dim strPathFile, WB_SRC As Workbook
strPathFile = Application.GetOpenFilename(FileFilter:="Fichiers EXCEL (*.XLSX), *.XLSX", Title:="Choisir votre fichier, svp")
If strPathFile = False Then Exit Sub
Set WB_SRC = Workbooks.Open(strPathFile)
'ligne pour test
MsgBox WB_SRC.FullName
End Sub
 
Vote positif 0 Vote négatif
E

Etn

XLDnaute Occasionnel
Du coup il faut combiner les deux macros (désolé je galère à comprendre).
Idéalement le processus devrait être :

- Je sélectionne le fichier
- Le fichier s'ouvre automatiquement
- Les données sont copiées
- Le fichier se referme

En assemblant les deux macros que tu m'as proposé cela donne :

VB: 
Sub test()
Dim WB_SRC As Workbook, WB_DST As Workbook, X&, Y&
 strPathFile = Application.GetOpenFilename(FileFilter:="Fichiers EXCEL (*.XLSX), *.XLSX", Title:="Choisir votre fichier, svp")
If strPathFile = False Then Exit Sub
Set WB_SRC = Workbooks.Open(strPathFile) 'OUVRIR LE FICHIER SOURCE
'ligne pour test
Dim WB_SRC As Workbook, WB_DST As Workbook, X&, Y&
Set WB_SRC = Workbooks("testetn.xlsx")
Dim WS As Worksheet
For Each WS In WB_SRC.Worksheets
With Sheets("BDD Stock bilan")
 X = .Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).Column
 Y = WS.[A1].CurrentRegion.Columns.Count
 .Cells(2, X).Resize(, Y) = WB_SRC.Name
 .Cells(3, X).Resize(, Y) = WS.Name
 WS.[A1].CurrentRegion.Copy
 .Cells(4, X).PasteSpecial xlValues 'COPIER LES DONNEES
 Set WB_SRC = Workbooks.Close(strPathFile) 'FERMER LE FICHIER SOURCE
End With
Next
End Sub

Malheureusement je sais pas où copier le "Dim WB_SRC As Workbook, WB_DST As Workbook, X&, Y&" (il pose problème dans l'exécution de la macro).
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
261
robpellan52
R
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
114
Francky79
F
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
327
gwenn49
G
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
440
olivier388
O
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
591
TooFatBoy
TooFatBoy
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
232
Zonmé
Z
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
302
Usine à gaz
Usine à gaz
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
366
fanou06
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
519
mouchtre
mouchtre

Membres actuellement en ligne

19 membres et 247 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 158
Messages
2 085 831
Membres
102 997
dernier inscrit
sedpo