XL 2010 Rapatriement données

[FCMLE44]

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

 

[FCMLE44]

Personne n'aurait une piste
je cherche désespérément sur le net et je ne trouve rien qui puisse m'aider

 

[Paf]

bonjour FCMLE44,

un essai à tester:

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+

 

[FCMLE44]

Merci

Cela fonctionne mais efface les données de ma première ligne sur le fichier B.
Est il possible de faire en sorte que la première ligne du fichier reste

Merci

 

[Paf]

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 :

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

A+

 

[FCMLE44]

Dois je le mettre à la place de

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

 

[FCMLE44]

Dois je le mettre à la place de celui-ci

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

 

[Paf]

re,

    FC.Range("A2:H" & DLC).ClearContents
    FC.Range("J2:N" & DLC).ClearContents

avant ces deux lignes insérer : If DLC > 1 Then
après ces deux lignes insérer : End If

A+