XL 2010 Rapatriement données

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

J'ai besoin de rapatrier les données d'un fichier (fichier A) dans un autre fichier (fichier B).

On irait chercher le fichier A dans un répertoire via une fenêtre
Les colonnes A à H du fichier A irait dans les colonnes A à H du fichier B
Les colonnes I à M du fichier A en colonne J à N du fichier B

Quelqu'un aurait-il une idée du code vba nécessaire

Merci beaucoup

Cordialement
 

Pièces jointes

  • Fichier A.xlsm
    15.5 KB · Affichages: 14
  • Fichier B.xlsm
    19 KB · Affichages: 18

Paf

XLDnaute Barbatruc
bonjour FCMLE44,

un essai à tester:
VB:
Sub FCMLE()
Dim Source As Workbook, Cible As Workbook, DLC As Long, DLS As Long, FC As Worksheet

Set Cible = ThisWorkbook
Set FC = Cible.Worksheets("Fichier de base")

DLC = FC.Range("A" & Rows.Count).End(xlUp).Row
FC.Range("A2:H" & DLC).ClearContents
FC.Range("J2:N" & DLC).ClearContents

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False 'n'autorise pas choix multiple
If .Show = -1 Then ' si fichier sélectionné
   Set Source = Workbooks.Open(.SelectedItems(1))
    With Source.ActiveSheet
     DLS = .Range("A" & Rows.Count).End(xlUp).Row
     .Range("A2:H" & DLS).Copy FC.Range("A2")
     .Range("I2:M" & DLS).Copy FC.Range("J2")
    End With
    Source.Close
Else
    MsgBox "Aucun fichier sélectionné"
    Exit Sub
End If
End With
End Sub

A+
 

Paf

XLDnaute Barbatruc
re,

la ligne de titre est effectivement effacée s'il n'y a pas de lignes de données. Pour l'éviter :

apporter cette modification :
VB:
If DLC > 1 Then
    FC.Range("A2:H" & DLC).ClearContents
    FC.Range("J2:N" & DLC).ClearContents
End If

A+
 

Discussions similaires

J
Réponses
39
Affichages
3 K
J
Réponses
4
Affichages
351

Statistiques des forums

Discussions
311 727
Messages
2 081 962
Membres
101 852
dernier inscrit
dthi16088