Sub OpenCopy()
Dim OpenFile, fileName As String, LastRow As Long, i As Integer
OpenFile = Application.GetOpenFilename("Excel files,*.xl*", _
                           1, "Select destination file", , False)
       Workbooks.Open fileName:=OpenFile
       fileName = ActiveWorkbook.Name
       Application.ScreenUpdating = False
       Application.DisplayAlerts = False
     LastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, "C").End(xlUp).Row
                           
      For i = 2 To LastRow
      ThisWorkbook.Sheets("Sheet1").Cells(i, "C").Copy
      ActiveWorkbook.Sheets("Sheet1").Cells(i, "A").Select
      ActiveWorkbook.Sheets("Sheet1").Paste
      
      ThisWorkbook.Sheets("Sheet1").Range("I" & i & ":N" & i).Copy
      ActiveWorkbook.Sheets("Sheet1").Cells(i, "N").Select
      ActiveWorkbook.Sheets("Sheet1").Paste
      Next i
      Application.CutCopyMode = False
      Workbooks(fileName).Close savechanges:=True
      
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
       
End Sub