XL 2016 Comment importer un classeur Excel dans un autre?

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...