XL 2019 Aide pour macro vba

Kev1407

XLDnaute Nouveau
Bonjour,

Je souhaiterais une macro qui me permettrait d'ouvrir un classeur et de récupérer des colonnes mais je ne sais pas comment m'y prendre.

Dans le classeur nommé "14052024.xlsx", je voudrais récupérer les colonnes A,B,C,D,E,F,G,J,N,Z,AB (mis en jaune dans le classeur) de l'onglet "Encours_solde" c'est à préciser car ce classeur pourra avoir d'autres feuilles.
Si possible copier les colonnes jusqu'à la dernier ligne non vide car le nombre de ligne différent chaque semaine.

Ensuite je voudrait les coller dans un classeur appelé "Indicateurs Tps passés.xlsm" onglet "Indicateur tps"

Serait il possible de m'aider, s'il vous plait?

Je vous remercie par avance.

Cordialement
 

Pièces jointes

  • 14052024.xlsx
    10.4 KB · Affichages: 7
Solution
Bonjour Kev1407, Bernard,

La macro complétée :
VB:
Sub ouverture_fichier()
Dim fichier As Variant, dest As Range, entete, derlig&
ChDir ThisWorkbook.Path
'ChDrive "P": ChDir "P:\DOSSIER PERSONNEL\K.DELCROIX"
fichier = Application.GetOpenFilename("Fichiers .xlsx (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
entete = [A1:M1]
Rows("2:" & Rows.Count).Delete 'RAZ
Set dest = [A1]
With Workbooks.Open(fichier)
    .Sheets("Encours_solde").[A:G,J:J,N:N,Z:Z,AB:AB].Copy dest
    .Close False
End With
'---formats et formules---
[A1:M1] = entete: [A1:M1].VerticalAlignment = xlCenter
derlig = ActiveSheet.UsedRange.Rows.Count
If derlig > 1 Then [L2:M2].Resize(derlig - 1) = Array("=I2-H2", "=I2/H2")...

job75

XLDnaute Barbatruc
Bonjour Kev1407,

Téléchargez les fichiers joints où vous voulez, ouvrez le fichier xlsm et exécutez cette macro :
VB:
Sub Importer()
Dim fichier As Variant, dest As Range
fichier = Application.GetOpenFilename("Fichiers .xlsx (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Cells.Delete 'RAZ
Set dest = [A1]
With Workbooks.Open(fichier)
    .Sheets("Encours_solde").Range("A:G,J:J,N:N,Z:Z,AB:AB").Copy dest
    .Close False
End With
End Sub
A+
 

Pièces jointes

  • 14052024.xlsx
    10.4 KB · Affichages: 0
  • Importation.xlsm
    15 KB · Affichages: 1

Kev1407

XLDnaute Nouveau
Bonjour Job75 et merci pour votre réponse.
En revanche dans mon cas je n'arrive pas à utiliser votre macro selon mon besoin.
Je me suis mal exprimé sur mon attente.

En effet je dois choisir un classeur différent chaque jour dans un dossier spécifique puis récupérer les colonnes cité dans le message précédent.

J'ai commencé la macro en faisant cela mais je ne sais pas si c'est la bonne approche.
A cela je voudrais ajouter la macro pour copier et coller les colonnes

Sub ouverture_fichier()

Dim fd As Office.FileDialog
Dim strFichier As String

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Fichiers Excel", "*.xlsx?", 1
.Title = "Choisissez un fichier Excel"
.AllowMultiSelect = False
.InitialFileName = "P:\DOSSIER PERSONNEL\K.DELCROIX"
If .Show = True Then
strFichier = .SelectedItems(1)

End If
End With


End Sub


Merci par avance pour vos retour.

Cordialement
 

Kev1407

XLDnaute Nouveau
il y a encore quelque chose que je n'arrive pas à faire, je voudrais que la ligne 1 ne change pas, en gros que les information soit copié et collé à partir de la ligne 2 pour ne pas changer les entêtes.
et que les colonnes L et M ne soit pas remplacé, puisque ce sera une formule.

Pouvez vous m'aider s'il vous plait?
 

Pièces jointes

  • Indicateurs Tps.xlsm
    402 KB · Affichages: 1
  • 14052024.xlsx
    10.4 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bonjour Kev1407, Bernard,

La macro complétée :
VB:
Sub ouverture_fichier()
Dim fichier As Variant, dest As Range, entete, derlig&
ChDir ThisWorkbook.Path
'ChDrive "P": ChDir "P:\DOSSIER PERSONNEL\K.DELCROIX"
fichier = Application.GetOpenFilename("Fichiers .xlsx (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
entete = [A1:M1]
Rows("2:" & Rows.Count).Delete 'RAZ
Set dest = [A1]
With Workbooks.Open(fichier)
    .Sheets("Encours_solde").[A:G,J:J,N:N,Z:Z,AB:AB].Copy dest
    .Close False
End With
'---formats et formules---
[A1:M1] = entete: [A1:M1].VerticalAlignment = xlCenter
derlig = ActiveSheet.UsedRange.Rows.Count
If derlig > 1 Then [L2:M2].Resize(derlig - 1) = Array("=I2-H2", "=I2/H2")
[M:M].NumberFormat = "0%"
Columns("A:K").AutoFit
If [A1].ColumnWidth < 16.71 Then [A1].ColumnWidth = 16.71
End Sub
A+
 

Pièces jointes

  • Indicateurs Tps.xlsm
    405.9 KB · Affichages: 2
  • 14052024.xlsx
    10.4 KB · Affichages: 3
Dernière édition:

Dranreb

XLDnaute Barbatruc
Attention: ChDir change seulement le dossier courant du lecteur indiqué dans le chemin, sans le définir comme lecteur courant. Si CurDir définit un dossier d'un autre lecteur il risque de ne pas être changé. Il serait prudent de faire aussi ChDrive ThisWorkbook.Path.
 

Discussions similaires

Statistiques des forums

Discussions
313 297
Messages
2 096 924
Membres
106 789
dernier inscrit
FrancoisVLD