Import de données entre deux classeurs

Bonjour à tous,

N'étant pas très fort en VBA, j'ai voulu ecrire un code permettant d'importer plusieurs sélections précises de données d'un autre classeur (Ce dernier est choisi via une boite de dialogue).

Après des recherches, j'ai rédigé un code qui fonctionne très bien mais à chaque sélection de données qu'il copie, une boite de dialogue apparait pour m'indiquer quelle zone, le programme cible. Or je voudrais que celles-ci n'apparaissent plus et qu'il copie automatiquement.

Jusqu'à maintenant, je n'ai toujours pas réussi...

Je ne sais pas si j'ai été assez précis.

Je vous remercie d'avance

Voici le code en question:

Sub import_anomalie()

Dim destination, source As Workbook
Dim rang_source, rang_destination As Range
Dim fin_ouvrage, fin_code, fin_longueur, fin_adresse, fin_comm, fin_numero, fin_jour As Long
fin_ouvrage = Range("A1048576").End(xlUp).Row + 1
fin_adresse = Range("G1048576").End(xlUp).Row + 1
fin_comm = Range("H1048576").End(xlUp).Row + 1

fin_code = Range("O1048576").End(xlUp).Row + 1
fin_longueur = Range("K1048576").End(xlUp).Row + 1

Set destination = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.AllowMultiSelect = False
.Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="A7:A10000", Type:=8)
            destination.Activate
            Set rang_destination = Range("A" & fin_ouvrage)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit
            End If
            If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="$C$7:$C$10000", Type:=8)
            destination.Activate
            Set rang_destination = Range("K" & fin_longueur)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit
            End If
            If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="F7:H10000", Type:=8)
            destination.Activate
            Set rang_destination = Range("M" & fin_code)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit
            [A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End If

            If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="B1", Type:=8)
            destination.Activate
            Set rang_destination = Range("H" & fin_adresse)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit

            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="B4", Type:=8)
            destination.Activate
            Set rang_destination = Range("B" & fin_adresse)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit

            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="B3", Type:=8)
            destination.Activate
            Set rang_destination = Range("C" & fin_adresse)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit

            Workbooks.Open .SelectedItems(1)
            Set source = ActiveWorkbook
            Set rang_source = Application.InputBox(prompt:="select source range", Title:="Sélection des données", Default:="B2", Type:=8)
            destination.Activate
            Set rang_destination = Range("G" & fin_adresse)
            rang_source.Copy rang_destination
            rang_destination.CurrentRegion.EntireColumn.AutoFit

              source.Close False
End If

End With

MsgBox ("Import de données terminé.")

End Sub

Salut et bienvenue sur le Forum,

Un code sans fichier, c'est "Pas de réponse" garanti à 93 %

Même un fichier sans code - mais avec des explications précises, faisant référence aux objets Excel - c'est encore mieux

Cordialement.