Copier deux colonnes d'un fichier Excel avec code VBA

Bonsoir,

Je souhaite ouvrir un fichier EXCEL copier les valeurs de deux colonnes ( jusqu'a la dernière ligne remplie) et coller les valeurs dans un second fichier excel à un endroit précis.J'arrive à copier le tableau entier mais je n'arrive pas a copier les deux colonnes et les mettre à un endroit précis. Quelqu'un pourrait il m'aider ?

J'ai fait ça

Sub importXLS()
Dim dialogBox As FileDialog
Dim selectedFile As String
Dim selectedXLS As String
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
selectedXLV = ThisWorkbook.Sheets("BASE COLLEGES").Range("J18").Value
With dialogBox
.Filters.Add "XLs", "*.xlsx", 1
.AllowMultiSelect = False
.InitialFileName = selectedXLS
If .Show = True Then
selectedFile = .SelectedItems(1)
End If
Debug.Print selectedFile
End With
If selectedFile <> "" Then
Open selectedFile For Input As #1
Dim lineFromFile As String
Dim lineItems As Variant
Dim itteration As Integer
rowNumber = 1
Do Until EOF(1) 'false till end of file is reache then it will turn true
Line Input #1, lineFromFile ' reads a single line from an open sequential file
lineItems = Split(lineFromFile, ";")
For itteration = 0 To UBound(lineItems) - LBound(lineItems)
Range("ImportRangeG").Cells(rowNumber, itteration + 1) = Replace(lineItems(itteration), """", "")
Next
rowNumber = rowNumber + 1
Loop



End If

End Sub

Mettre les données Dossard et temps brut du fichier 1 colonne dossard et temp dans ce fichier en desoous de dossard et temp. C'est peut etre plus simple comme cela

Salut EFO,

une façon de faire avec les 2 fichiers concernés ouverts.
Dans le fichier EFO-A, tu sélectionnes ensemble les titres de colonnes à copier, simplement. La copie est instantanée et le fichier-cible EFO-B est affiché.

Les noms de fichier et de feuille A-B doivent évidemment être adaptés ainsi que l'adresse des colonnes à copier, ici dans l'exemple [B1:C1].
Le code doit être copié dans le module de la feuille du fichier A

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim iRow%
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Selection.Count = 2 Then
    If Not Intersect(Selection, [B1:C1]) Is Nothing Then
        iRow = Range("B" & Rows.Count).End(xlUp).Row
        With Workbooks("EFO-B").Worksheets("BDD")
            .Range("F2:G" & iRow).Value = Workbooks("EFO-A").Worksheets("BDD").Range("B2:C" & iRow).Value
            .Activate
        End With
    End If
End If
'
Application.EnableEvents = True
Application.ScreenUpdating = True
'
End Sub

A+