XL 2016 Comment importer un classeur Excel dans un autre?

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: 12
  • Sans doublons.xlsm
    22 KB · Affichages: 8
Solution
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...

fanch55

XLDnaute Accro
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
 

Jovial87

XLDnaute Nouveau
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
Merci beaucoup franc55. Je viens d'adapter votre code et ca marche
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
293 048
Messages
1 928 125
Membres
183 855
dernier inscrit
safelhr