XL 2019 Aide pour macro vba

Kev1407 · 22 Mai 2024

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

job75 · 23 Mai 2024

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 · 24 Mai 2024

Etant donné que mes information sont sur un serveur distant je n'arrive pas à trouver le répertoire.

LE dossier à ouvrir se trouve sur cette adresse "\\213.56.106.123\rhea\

Donc avec ChDrive je n'arrive pas à l'ouvrir ...

Kev1407 · 24 Mai 2024

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 · 24 Mai 2024

Il vaudrait peur être mieux If Not .Show Then Exit Sub

Kev1407 · 24 Mai 2024

Dranreb à dit:
Il vaudrait peur être mieux If Not .Show Then Exit Sub

Ah quel endroit et quel impact sur le déroulement de la macro?

Dranreb · 24 Mai 2024

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 · 24 Mai 2024

Dranreb à dit:
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

XL 2019 Aide pour macro vba

Kev1407

XLDnaute Nouveau

Pièces jointes

job75

Kev1407

XLDnaute Nouveau

Kev1407

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Kev1407

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Kev1407

XLDnaute Nouveau

Discussions similaires