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")...

Kev1407

XLDnaute Nouveau
J'ai réussi
en faisant de cette manière

VB:
Sub ouverture_fichier()

Dim fd As Office.FileDialog
Dim strFichier As String, dest As Range, entete, derlig&

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Fichiers Excel", "*.xlsx?", 1
.Title = "Choisissez un fichier Excel"
.AllowMultiSelect = False
.InitialFileName = "\\213.56.106.123\rhea\TCAPON\2024"
If .Show = True Then
strFichier = .SelectedItems(1)

End If
End With


Application.ScreenUpdating = False
entete = [A1:M1]
Rows("2:" & Rows.Count).Delete 'RAZ
Set dest = [A1]
With Workbooks.Open(strFichier)
    .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
[L1:M1].HorizontalAlignment = xlCenter
derlig = ActiveSheet.UsedRange.Rows.Count
If derlig > 1 Then [L2:M2].Resize(derlig - 1) = Array("=I2-H2", "=I2/H2")
[M:M].NumberFormat = "0%"
If [A1].ColumnWidth < 16.71 Then [A1].ColumnWidth = 16.71
Columns("B:K").AutoFit


End Sub
 

Dranreb

XLDnaute Barbatruc
Le but est de ne pas tenter d'exécuter inutilement la suite si en fin de compte aucun fichier n'est choisi.
J'aime décidément mieux le GetOpenFilenamme au Application.FileDialog : c'est plus concis, mais pour positionner préalablement CurDir sur un chemin de réseau il faut alors utiliser une Api :
VB:
Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
…
SetCurrentDirectory "\\213.56.106.123\rhea\TCAPON\2024"
 

Kev1407

XLDnaute Nouveau
Le but est de ne pas tenter d'exécuter inutilement la suite si en fin de compte aucun fichier n'est choisi.
J'aime décidément mieux le GetOpenFilenamme au Application.FileDialog : c'est plus concis, mais pour positionner préalablement CurDir sur un chemin de réseau il faut alors utiliser une Api :
VB:
Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
…
SetCurrentDirectory "\\213.56.106.123\rhea\TCAPON\2024"
Ca devient compliqué je n'ai pas le niveau du tout lol

En tous cas merci pour le moment ça fonctionne je pense que ça ira bien comme cela.

Merci à vous
 

Discussions similaires

Statistiques des forums

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