VBA Importation de données avec un critère vers un autre classeur.

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

quicestraoul

XLDnaute Nouveau
Bonjour,

Je sais que vous n'êtes pas une société de services en ingénierie informatique. Mais j'ai vraiment besoin de votre aide.

Voici
Je souhaite que sur une feuille il y ait un bouton en cliquant sur ce dernier il me propose d'ouvrir un classeur, puis recherche dans la première colonne 2015. Pour chaque ligne où dans la 1ère colonne il y a 2015 la sélectionner et la copier dans mon classeur d'origine sur une autre feuille que celle où il y a le bouton. puis répéter l’opération pour 32 fichiers différents que je souhaite choisir. Les fichiers sources sont des extracts d'un progiciel qui doivent rester inchangés. Les extracts sont fait par une personnes pour tout le monde. Je dois copier-coller les lignes où la première cellule en colonne A commence par 2015.
je suppose utiliser :


Code:
Public FeuilleSynFi As Worksheet
Public Const SynFi_NumColRubrique As Integer = 1
Public ListeFE As Worksheet
 
Sub Upload_synth()
       Application.Workbooks.Open Application.GetOpenFilename()
          If (FichierSelectionne = "") Then
              ' Pas de fichier sélectionné
              AbandonneTraitement = True 
 
          Else
For j = 1 To 100000
    If (FeuilleSynFi.Cells(SynFi_NumLig, SynFi_NumColRubrique).Value = "2015" & "*") Then
                Rows(ActiveCell.Row).Select
                Selection.Copy
                Selection.Paste Destination:=ListeFE.Cells(LastRow, j + 1)
       Next for
 End If
 
End Sub

Mais je n'y arrive pas du tout.

Merci de votre aide.
 
Re : VBA Importation de données avec un critère vers un autre classeur.

Si l'erreur se fait sur la ligne d'en dessous c'est que le "2015*" passe bien!
Par contre l'erreur 429 je l'avais sur ton fichier au début, c'est pour ça que je te donne le code uniquement car j'ai du le refaire sur une nouveau classeur...
Peut-être pour ça...
Refais toi un classeur à neuf et essaie de lancer la macro sans bouton pour le moment!
 
Re : VBA Importation de données avec un critère vers un autre classeur.

Alors voilà j'ai avancé à partir d'une autre macro que j'ai modifié, mais là ça fait un balayage des fichiers. je suis donc obligé de les réunir dans un dossier où sera mon fichier final si quelqu'un a la solution pour aller chercher fichier par fichier sans qu'ils soient tous dans le même dossier (soit 32 fichiers à ce jour)

Code:
Public ListeFe As Worksheet
Public ComparaisonFe As Worksheet

Public Const Liste_NumLigDeb As Integer = 2

Public Const ListeBases_NumLigDeb As Integer = 3

Public Const ListeBases_NumColCodeProjet As Integer = 1
Public Const ListeBases_NumColLast As Integer = 26


Public Const Appli_NumLigMax As Long = 200000

Sub Upload()
' Cette procédure a pour but de concaténer les Listes

    Application.Calculation = xlManual
    
    Set ListeFe = ThisWorkbook.Worksheets("Liste")
    Set ComparaisonFe = ThisWorkbook.Worksheets("Comparaison")
    
    
    Repertoire = ThisWorkbook.Path
    Nom_Fichier = ThisWorkbook.Name
    Liste_NumLig = Liste_NumLigDeb
    j = 3
    
    
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    ' Suppression des lignes du Liste
    Range(ListeFe.Cells(Liste_NumLigDeb, 1), ListeFe.Cells(Appli_NumLigMax, ListeBases_NumColLast)).ClearContents
    
    
    ' balayage de tous les fichiers du répertoire
    FichS = Dir(Repertoire & "\*.xls*")
    While ((FichS <> "") And (Left(FichS, 1) <> "~"))
        j = j + 1
        'ComparaisonFe.Cells(j, 1).Value = FichS
        
        If (FichS = Nom_Fichier) Then
            FichS = Dir
        Else
            FichS_nom_complet = Repertoire & "\" & FichS
            Workbooks.Open FichS_nom_complet
               
            Dim i As Integer
                
            For i = 1 To Worksheets.Count
                If (Worksheets(i).Name = "Synthese financiere") Then
                    ListeBases_NumLig = ListeBases_NumLigDeb
                    While (Worksheets(i).Cells(ListeBases_NumLig, ListeBases_NumColCodeProjet) <> "")
                        ListeBases_NumLig = ListeBases_NumLig + 1
                    Wend
                    
                    Range(Worksheets(i).Cells(ListeBases_NumLigDeb, 1), Worksheets(i).Cells(ListeBases_NumLig, ListeBases_NumColLast)).Select
                    Selection.Copy
                    ListeFe.Activate
                    Range(ListeFe.Cells(Liste_NumLig, 1), ListeFe.Cells(Liste_NumLig, ListeBases_NumColLast)).Select
                    ActiveSheet.Paste
                    Liste_NumLig = Liste_NumLig + ListeBases_NumLig - ListeBases_NumLigDeb
                    
                End If
            Next i
            Workbooks(FichS).Close
            FichS = Dir
               
        End If
    Wend
    
    Application.EnableEvents = True
    Application.DisplayAlerts = True


Application.Calculation = xlAutomatic
End Sub
 
Re : VBA Importation de données avec un critère vers un autre classeur.

Dans ce cas là fais la liste des emplacements et des fichiers dans ton tableau excel et tu fais une boucle dessus!
Comme ça tu peux modifier, ajouter ou supprimer tes fichiers et ta liste et la macro tournera dessus!
 
Re : VBA Importation de données avec un critère vers un autre classeur.

Tous les fichiers peuvent être n'importe où car il n'y a pas d'emplacement final déterminé du fait des accès restreint de chacun 🙁 Peut etre après mais pour l'instant je dois poivoir prendre le fichier A aussi bien sur le serveur qu'en local, de même pour B. ET mon fichier "récap" peut etre en local ou dans un autre dossier du serveur. C'est un peu bizarre je te l'accorde 🙂
 
Re : VBA Importation de données avec un critère vers un autre classeur.

Pour éviter le problème d'erreur 429 activeX , le code suivant le contourne:
VB:
Sub t()
              a = ActiveWorkbook.Name
 
       nf = Application.GetOpenFilename("Fichiers Xls,*.xls*")
    If Not nf = False Then
        Workbooks.Open nf
         Set AWB = ActiveWorkbook
            For j = 1 To 100000
                If AWB.Sheets(1).Cells(j, 1) Like "2015*" Then
                    AWB.Sheets(1).Rows(j).Copy Workbooks(a).Sheets(3).Range("A100000").End(xlUp).Offset(1, 0)
                End If
            Next j
    End If
AWB.Close


End Sub

Par contre je ne sais pas pourquoi le thisworkbook dans ce classeur renvoie cette erreur!!!
Si un spécialiste peut nous éclairer?
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
176
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
652
Réponses
3
Affichages
584
Réponses
7
Affichages
798
Retour