Run-time error '9': Subscript out of range

You have to open the files first, using exact file names (including their absolute path), and exact sheet names including any spaces

Option Explicit Sub CopyColumn() Const FILE1 As String = "C:\TestFile1.xlsx" Const FILE2 As String = "C:\TestFile2.xlsx" Const SHEET1 As String = "Sheet2" Const SHEET2 As String = "Sheet1" Const COL1 As String = "A" Const COL2 As String = "D" Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook, wbInfo As String Dim ws1 As Worksheet, ws2 As Worksheet, ws As Worksheet Dim sourceColumn As Range, targetColumn As Range If Dir(FILE1) > vbNullString And Dir(FILE2) > vbNullString Then For Each wb In Workbooks wbInfo = "\" & wb.Name If InStr(1, FILE1, wbInfo, vbBinaryCompare) > 0 Then Set wb1 = wb If InStr(1, FILE2, wbInfo, vbBinaryCompare) > 0 Then Set wb2 = wb Next If wb1 Is Nothing Then Set wb1 = Workbooks.Open(FILE1) If wb2 Is Nothing Then Set wb2 = Workbooks.Open(FILE2) If Not wb1 Is Nothing And Not wb2 Is Nothing Then For Each ws In wb1.Worksheets If ws.Name = SHEET1 Then Set ws1 = ws Next For Each ws In wb2.Worksheets If ws.Name = SHEET2 Then Set ws2 = ws Next If Not ws1 Is Nothing And Not ws2 Is Nothing Then Set sourceColumn = wb1.Worksheets(SHEET1).UsedRange.Columns(COL1) Set targetColumn = wb2.Worksheets(SHEET2).UsedRange.Columns(COL2) sourceColumn.Copy Destination:=targetColumn End If End If End If End Sub 

This also checks if the files are already open or not, and if sheet names exists in each file