XL 2021 import-informations-classeurs-fermes

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir à toues et à tous,
Je vous souhaite une belle fin de journée :)

Il y a déjà longtemps, mon cher job75 m'avait fait un code que j'avais "un peu" modifié pour l'adapter exactement au besoin de mon fichier de travail.
Il fonctionne parfaitement :
VB:
Option Explicit

Sub Import()
Dim t#, chemin$, fichier$, feuille$, ncol%, dest As Range, form$, h As Variant, n&
t = Timer
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "fichier*.xlsm") '1er fichier du dossier
If fichier = "" Then MsgBox "Aucun fichier de facturation trouvé..."
feuille = "RdV_transfert"
ncol = 11 'nombre de colonnes à copier dans la feuille source (A:Z)
Set dest = Sheets("RdV_transfert").[A1] '1ère cellule du tableau, à adapter
Application.ScreenUpdating = False
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
While fichier <> ""
    form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
    h = ExecuteExcel4Macro("MATCH(9^9," & form & "A1)") 'recherche du dernier nombre
    If IsNumeric(h) Then
        If h > 3 Then 'à partir de la ligne 4
            With dest(2, 2).Offset(n).Resize(h - 3, ncol)
                .Columns(0) = fichier 'colonne A supplémentaire
                .FormulaArray = "=TRIM(" & form & "R4C1:R" & h & "C" & ncol & ")" 'formule de liaison matricielle
                .Value = .Value 'supprime les formules
            End With
            n = n + h - 3
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
'---mise en forme---
If n Then
    With dest(2).Resize(n, ncol + 1)
        .Borders.Weight = xlHairline
        .BorderAround Weight:=xlThin 'pourtour
    End With
End If
dest(2).Offset(n).Resize(Rows.Count - n - dest.Row, ncol + 1).Delete xlUp 'RAZ en dessous
'dest.Parent.Columns.AutoFit 'ajustement largeurs
With dest.Parent.UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "RdV_transfert"
End Sub

Aujourd'hui, j'ai besoin de l'utiliser pour un autre besoin que je décris ci-dessous :
Importer à partir des classeurs (classeurs sources)
fichier_Charlotte : onglet RdV_transfert
fichier_Lionel : onglet RdV_transfert
de A2 à K2 jusqu'à dernière ligne NON vide
si C2 = date (aujourdhui()) et si écart de jours entre B2 et C2 est > à 3
Important : B2 et C2 ne sont pas au même format (pour le calcul de l'écart)
..........Sinon, ne pas importer

Classeur cible

SMS_jour test : onglet RdV_transfert

Tous les onglets "RdV_transfert " des fichiers sont identiques

Voilà plusieurs jours que je tente de l'adapter mais je n'y arrive pas car le niveau de technicité du code ne me permets pas de le comprendre.

Pourriez-vous m'aider ?
En cas, je joins les fichiers et je continue d'essayer
Avec mes remerciements,
Amicalement,
lionel :)
 

Pièces jointes

  • SMS_jour test.xlsm
    37 KB · Affichages: 12
  • fichier_Charlotte.xlsm
    32.5 KB · Affichages: 9
  • fichier_lionel.xlsm
    32.6 KB · Affichages: 10
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonsoir
Lionel
ben deja ta version mono fichier ne fonctionne pas la formule n'est pas bonne il mange le range
1643398243820.png
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Gérard, Bonjour Patrick, Bonjour Marcel, Bonjour le Forum,
Je vous souhaite une belle journée :)
@ Patrick et Marcel :

Importer, sans les ouvrir, les informations des classeurs

- fichier_Charlotte : onglet RdV_transfert et

- fichier_Lionel : onglet RdV_transfert

- dans le classeur SMS_jour test : onglet RdV_transfert

(il y aura d'autres fichiers fichier_XXXXXX : onglet RdV_transfert à importer)

Importer à partir des classeurs (classeurs sources)
Voici les captures d'écrans :

fichier_Charlotte : onglet RdV_transfert
1643454380633.png

fichier_Lionel : onglet RdV_transfert
1643454409096.png

de A2 à K2 jusqu'à dernière ligne NON vide
si C2 = date (aujourdhui()) et si écart de jours entre B2 et C2 est > à 3
Important : B2 et C2 ne sont pas au même format (pour le calcul de l'écart)
..........Sinon, ne pas importer

Classeur cible - RESULTAT ATTENDU

SMS_jour test : onglet RdV_transfert
1643454356222.png

Tous les onglets "RdV_transfert " des fichiers sont identiques

Les fichiers tests sont en #post 1
Un grand merci à vous deux et à Laurent pour m'avoir répondu et tenter de m'aider :)
lionel :)
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
ben avec tes fichier que ce soit Adobd.connection ,macro4 ou même formule de liaison
les fichiers sont en lecture seules
par exemple avec les formules de liaison ça m'ouvre le dialog d'ouverture de fichier donc le chemin n'est pas bon
sauf que ce que je vois dans la console est bon
1643457287855.png

avec ça on va pas aller très loin 😅
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour @Marcel32
il y a un soucis d'accès a ses fichiers c'est tout
  1. protection
  2. lecture seule
  3. vérolé
  4. corrompu
c'est simple
une formule de liaison qui ouvre le dialog de mise a jour c'est que le fichier n'est pas accessible
exemple formule de liaison
='C:\Users\polux\DeskTop\[cible.xlsx]Feuil1'!$A$3
cette formule peut être exécutée en macro4 ou mis dans une cellule
elle donnera le résultat si les données sont bonnes sinon c'est la boite de dialogue de mise a jour des liaisons
et avec le fichier charlotte c'est le cas, je teste même pas le 2d 😅

il n'a plus qu'une solution à l'ancienne avec workbooks.open et lecture puis fermeture
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Moi, vu mes faibles connaissances, il m'est difficile de vraiment aider, mais je profite parfois de certains fils de discussion pour poser des questions afin d'essayer d'en apprendre un peu plus.
Re marcel : OUI j'essaie mais vu mon niveau, je n'y comprends rien et les codes de Job75 sont hyper techniques et très difficiles à adapter pour moi :rolleyes: snifff
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
re
Bonjour @Marcel32
il y a un soucis d'accès a ses fichiers c'est tout
  1. protection
  2. lecture seule
  3. vérolé
  4. corrompu
c'est simple
une formule de liaison qui ouvre le dialog de mise a jour c'est que le fichier n'est pas accessible
exemple formule de liaison
='C:\Users\polux\DeskTop\[cible.xlsx]Feuil1'!$A$3
cette formule peut être exécutée en macro4 ou mis dans une cellule
elle donnera le résultat si les données sont bonnes sinon c'est la boite de dialogue de mise a jour des liaisons
et avec le fichier charlotte c'est le cas, je teste même pas le 2d 😅

il n'a plus qu'une solution à l'ancienne avec workbooks.open et lecture puis fermeture
Re Patrick, merci de te pencher sur mon problème :)

il n'y a pas de soucis d'accès aux fichiers :
  1. protection = non
  2. lecture seule= non
  3. vérolé = non
  4. corrompu = non
Effectivement, quand j'ouvre les fichiers en 1er et que j'importe avec liaisons, ça importe bien.
Mais Gérard l'a fait (code en #post1) pour un autre besoin pour des fichiers dans une autre sous-directory et ça fonctionne super bien,

Mais trop technique pour moi et impossible de l'adapter 🥵
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG