Macro pour copier/coller

Bonjour à tous et bon dimanche

Je suis a la recherche d'une macro qui me permet de copier les cellules d'un fichier dont le nom peut-être différent (donc j'aurais la possibilité de choisir le fichier), dans le fichier sélectionné la feuille se nome "base1" et la plage de cellule a copier "B2 à C150" et ensuite elle devront être collée dans mon classeur actif dans la plage C5.

Je vous remercie d'avance.

Bonne journée

Bonjour,

Option Explicit
Sub importer()
Dim NomFichier As Variant, wkb As Workbook
With ActiveSheet
    NomFichier = Application.GetOpenFilename("Classeurs Excel(*.xlsx),*.xlsx)")
    If NomFichier = False Then Exit Sub
    Workbooks.Open Filename:=NomFichier
    NomFichier = Dir(NomFichier)
    Set wkb = Workbooks(NomFichier)
    wkb.Sheets("base1").Range("B2:C150").Copy Destination:=.Range("C5")
    Workbooks(NomFichier).Close
End With
End Sub

Steelson a écrit :

Bonjour,

Option Explicit
Sub importer()
Dim NomFichier As Variant, wkb As Workbook
With ActiveSheet
    NomFichier = Application.GetOpenFilename("Classeurs Excel(*.xlsx),*.xlsx)")
    If NomFichier = False Then Exit Sub
    Workbooks.Open Filename:=NomFichier
    NomFichier = Dir(NomFichier)
    Set wkb = Workbooks(NomFichier)
    wkb.Sheets("base1").Range("B2:C150").Copy Destination:=.Range("C5")
    Workbooks(NomFichier).Close
End With
End Sub

Bonjour Steelson

super mais j'ai oublier de préciser la plage de cellule C es une formule, donc j'aimerai quand il colle les valeurs dans mon classeur actuel, qu'il colle uniquement le résultat et pas la formule

un genre de coller valeur

merci

Voici, j'y ai mis les valeurs et le format.

Option Explicit
Sub importer()
Dim NomFichier As Variant, wkb As Workbook
With ActiveSheet
    NomFichier = Application.GetOpenFilename("Classeurs Excel(*.xlsx),*.xlsx)")
    If NomFichier = False Then Exit Sub
    Workbooks.Open Filename:=NomFichier
    NomFichier = Dir(NomFichier)
    Set wkb = Workbooks(NomFichier)
    wkb.Sheets("base1").Range("B2:C150").Copy
    ' valeurs
    .Range("C5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' format
    .Range("C5").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Workbooks(NomFichier).Close
End With
End Sub

bonjour Steelson

Un grand merci pour ton aide

j'ai une petite question :

est-il possible, au lieu de choisir les cellules jusque C150 de sélectionner jusque la dernière ligne remplie ?

Bon dimanche

2 façon de faire,

soit

wkb.Sheets("base1").UsedRange.Copy

mais tu risque d'en avoir de trop

soit

wkb.Sheets("base1").Range("B2:C" & wkb.Sheets("base1").Cells(rows.count,"C").end(xlup).row).Copy

pas testé, mais cela doit être bon

yes, c'est bon