XL 2016 Comment importer un classeur Excel dans un autre?

J

Jovial87

XLDnaute Nouveau
Bonjour,

Malgré tous mes efforts, je n'arrive pas à réaliser ces deux opérations avec VBA Excel:

Avec les classeurs que je joins à ce message, je souhaite:
  1. Via explorateur Windows, je cherche a importer le tableau du fichier nommé "Origine" dans la feuille "Source" du classeur "Sans doublon" (Je ne souhaite pas faire copier-coller). L'action doit remplacer toutes les données précédentes
  2. A l'exécution de la macro sur la feuille "Table" du classeur "Sans doublons", Excel puisse effectuer ces trois vérifications sur la feuille "Source":
    1. Si la feuille de SOURCE est vide, la macro s'arrête et renvoie le message "La feuille Source est vide. veuillez le compléter pour continuer".
    2. Si dans la plage A2:A100 de la feuille "Source" 'il n'y a qu'une seule valeur (en A2), celle-ci soit copier puis coller dans la cellule A2 de feuille "Table".
    3. Si la plage A2:A100 contient plus d'une valeur, toutes les valeurs soient copiées. La macro disponible répond a ce sous point, mais pas les autres.
Merci d'avance pour toute réponse
 

Pièces jointes

  • Origine.xlsx
    10.2 KB · Affichages: 16
  • Sans doublons.xlsm
    22 KB · Affichages: 12
Solution
fanch55
Bonjour,
le code ci-dessous a remplacer dans votre Module de Sans Doublons .
Celui-ci répond strictement à votre demande,
je ne suis absolument pas sur que ce soit vraiment ce que vous souhaitiez .... 🤔

VB: 
Sub CopyOrigine()
    Application.DisplayAlerts = False
    With Workbooks.Open(ThisWorkbook.Path & "\Origine.xlsx", ReadOnly:=True)
        .Worksheets("Origine").Copy After:=ThisWorkbook.Worksheets("Source")
        .Close
    End With
    ThisWorkbook.Worksheets("Source").Delete
    
    ThisWorkbook.Worksheets("Origine").Name = "Source"
    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Worksheets("Source")
        Sh.[_CodeName] = "Sheet2"
    Set Sh = Nothing

End Sub
Sub Sumif()
    
    ' 1 Je voulais qu'au debut de la procedure...
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonjour,
le code ci-dessous a remplacer dans votre Module de Sans Doublons .
Celui-ci répond strictement à votre demande,
je ne suis absolument pas sur que ce soit vraiment ce que vous souhaitiez .... 🤔

VB: 
Sub CopyOrigine()
    Application.DisplayAlerts = False
    With Workbooks.Open(ThisWorkbook.Path & "\Origine.xlsx", ReadOnly:=True)
        .Worksheets("Origine").Copy After:=ThisWorkbook.Worksheets("Source")
        .Close
    End With
    ThisWorkbook.Worksheets("Source").Delete
    
    ThisWorkbook.Worksheets("Origine").Name = "Source"
    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Worksheets("Source")
        Sh.[_CodeName] = "Sheet2"
    Set Sh = Nothing

End Sub
Sub Sumif()
    
    ' 1 Je voulais qu'au debut de la procedure, excel verifie si la feuille "Source" est vide. si oui, qu'il arrete la procedure avec le message:_
         '"La feuille source est vide. Veuillez completer pour continuer"

    If Worksheets("Source").Cells.Find("*") Is Nothing Then
        Worksheets("Source").Activate
        MsgBox "La feuille source est vide." & vbLf & "Veuillez completer pour continuer", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    
    ' 2 S'il n'y a qu'une seule donnee dans la plage A2:A100 de la feuille source,
    ' qu'elle soit prise en compte
    If Worksheets("Source").Columns("A").Find("*", searchdirection:=xlPrevious).Row = 2 Then
        If Worksheets("Source").[A2] <> vbNullString Then
            Worksheets("Table").[A2] = Worksheets("Source").[A2]
            Worksheets("Table").[A2].Activate
        End If
        Exit Sub
    End If
    
    ' 3 S'il y a plus d'une donnee dans plage A2:A de feuille source, la procedure ci-dessous soit lancee.
    Sumif_Old
    
End Sub
Sub Sumif_Old()
Dim Qty As Integer

Application.ScreenUpdating = False

'Ici 3 soucis majeurs pour:
    ' 1 Je voulais qu'au debut de la procedure, excel verifie si la feuille "Source" est vide. si oui, qu'il arrete la procedure avec le message:_
         '"La feuille source est vide. Veuillez completer pour continuer"
    ' 2 S'il n'y a qu'une seule donnee dans la plage A2:A100 de la feuille source, qu'elle soit prise en compte
    ' 3 S'il y a plus d'une donnee dans plage A2:A de feuille source, la procedure ci-dessous soit lancee.
        
         '#### J'AI ESSAYE SANS SUCCES - JE VOUS DEMANDE DE L'AIDE ###

Sheet2.Select
    Range("A2", Range("A2").End(xlDown)).Select
    Selection.Copy
    Range("A2").Select

Sheet1.Select
    Range("A2").PasteSpecial xlPasteValues
    ActiveSheet.Range("$A$2:$A$100000").RemoveDuplicates Columns:=1, Header:= _
        xlYes

'  Existe-t-il un moyen de racourcir l'ecriture ci-dessous pour le meme resultat?
        ActiveWorkbook.Worksheets("Table").AutoFilter.Sort.SortFields.Clear 'y a-t-il moyen d'utiliser Sheet1 au lieu de "Table"? (pour ne pas etre limite lors de modifcation de nom de feuilles)
        ActiveWorkbook.Worksheets("Table").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A100000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Table").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

With Sheet1

    For x = 2 To 100

        Qty = WorksheetFunction.Sumif(Sheet2.Range("A2:A100"), Sheet1.Cells(x, 1), Sheet2.Range("C2:C100"))
    
        If .Cells(x, 1) <> "" Then
            .Cells(x, 3) = Qty
            .Cells(x, 2) = "PCE"
        Else
                Cells(x, 2).Value = ""
        End If
            
    Next x
    .Range("A:C").Columns.AutoFit
End With
    Sheet1.Range("A1").Select
End Sub
 
Vote positif 0 Vote négatif
Solution
J

Jovial87

XLDnaute Nouveau
fanch55 à dit:
Bonjour,
le code ci-dessous a remplacer dans votre Module de Sans Doublons .
Celui-ci répond strictement à votre demande,
je ne suis absolument pas sur que ce soit vraiment ce que vous souhaitiez .... 🤔

VB: 
Sub CopyOrigine()
    Application.DisplayAlerts = False
    With Workbooks.Open(ThisWorkbook.Path & "\Origine.xlsx", ReadOnly:=True)
        .Worksheets("Origine").Copy After:=ThisWorkbook.Worksheets("Source")
        .Close
    End With
    ThisWorkbook.Worksheets("Source").Delete
   
    ThisWorkbook.Worksheets("Origine").Name = "Source"
    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Worksheets("Source")
        Sh.[_CodeName] = "Sheet2"
    Set Sh = Nothing

End Sub
Sub Sumif()
   
    ' 1 Je voulais qu'au debut de la procedure, excel verifie si la feuille "Source" est vide. si oui, qu'il arrete la procedure avec le message:_
         '"La feuille source est vide. Veuillez completer pour continuer"

    If Worksheets("Source").Cells.Find("*") Is Nothing Then
        Worksheets("Source").Activate
        MsgBox "La feuille source est vide." & vbLf & "Veuillez completer pour continuer", vbExclamation + vbOKOnly
        Exit Sub
    End If
   
   
    ' 2 S'il n'y a qu'une seule donnee dans la plage A2:A100 de la feuille source,
    ' qu'elle soit prise en compte
    If Worksheets("Source").Columns("A").Find("*", searchdirection:=xlPrevious).Row = 2 Then
        If Worksheets("Source").[A2] <> vbNullString Then
            Worksheets("Table").[A2] = Worksheets("Source").[A2]
            Worksheets("Table").[A2].Activate
        End If
        Exit Sub
    End If
   
    ' 3 S'il y a plus d'une donnee dans plage A2:A de feuille source, la procedure ci-dessous soit lancee.
    Sumif_Old
   
End Sub
Sub Sumif_Old()
Dim Qty As Integer

Application.ScreenUpdating = False

'Ici 3 soucis majeurs pour:
    ' 1 Je voulais qu'au debut de la procedure, excel verifie si la feuille "Source" est vide. si oui, qu'il arrete la procedure avec le message:_
         '"La feuille source est vide. Veuillez completer pour continuer"
    ' 2 S'il n'y a qu'une seule donnee dans la plage A2:A100 de la feuille source, qu'elle soit prise en compte
    ' 3 S'il y a plus d'une donnee dans plage A2:A de feuille source, la procedure ci-dessous soit lancee.
       
         '#### J'AI ESSAYE SANS SUCCES - JE VOUS DEMANDE DE L'AIDE ###

Sheet2.Select
    Range("A2", Range("A2").End(xlDown)).Select
    Selection.Copy
    Range("A2").Select

Sheet1.Select
    Range("A2").PasteSpecial xlPasteValues
    ActiveSheet.Range("$A$2:$A$100000").RemoveDuplicates Columns:=1, Header:= _
        xlYes

'  Existe-t-il un moyen de racourcir l'ecriture ci-dessous pour le meme resultat?
        ActiveWorkbook.Worksheets("Table").AutoFilter.Sort.SortFields.Clear 'y a-t-il moyen d'utiliser Sheet1 au lieu de "Table"? (pour ne pas etre limite lors de modifcation de nom de feuilles)
        ActiveWorkbook.Worksheets("Table").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A100000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Table").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

With Sheet1

    For x = 2 To 100

        Qty = WorksheetFunction.Sumif(Sheet2.Range("A2:A100"), Sheet1.Cells(x, 1), Sheet2.Range("C2:C100"))
   
        If .Cells(x, 1) <> "" Then
            .Cells(x, 3) = Qty
            .Cells(x, 2) = "PCE"
        Else
                Cells(x, 2).Value = ""
        End If
           
    Next x
    .Range("A:C").Columns.AutoFit
End With
    Sheet1.Range("A1").Select
End Sub
Cliquez pour agrandir...
Merci beaucoup franc55. Je viens d'adapter votre code et ca marche
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
162
sylvanu
sylvanu
BenHarber
  • Question
Microsoft 365 Interroger un fichier source d'un autre format qu'Excel ?
Réponses
3
Affichages
146
BenHarber
BenHarber
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
1 K
Hutchy33
H
P
  • Question
Microsoft 365 copier coller un onglet dans un autre fichier
Réponses
6
Affichages
252
pralo
P
Y
  • Résolu(e)
XL 2013 Récupérer le contenu d'un Tableau dans un autre classeur via Power Query et non toute la feuille...
Réponses
4
Affichages
194
Yvan1
Y
J
  • Résolu(e)
XL 2016 Validation d'une ligne et transfert de la ligne vers un autre classeur
Réponses
8
Affichages
209
job75
job75
oguruma
POWERQUERY :: Combinaisons (Table.Combine) de dossiers contenant des fichiers .CSV ou des fichiers Excel - V2
Réponses
0
Affichages
260
oguruma
oguruma
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
258
robpellan52
R
Oscar21
  • Question
Microsoft 365 Importer données de plusieurs classeurs dans un autre sans VBA
Réponses
7
Affichages
623
chris
chris
oguruma
POWERQUERY :: Combiner les onglets d'un classeur Excel ou certains au cas par cas
Réponses
0
Affichages
124
oguruma
oguruma

Membres actuellement en ligne

Aucun membre en ligne actuellement.
3 membres et 59 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa