Copy rows from one excel file to another and allocate row.cells in the right columns - excel

Question

I have been trying to copy a range of rows, with 4 columns each, to a new csv file. I want the cells to be allocated correctly. The files are shown below.
So, "Code", "Name", "Surname", "Number" cells need to be copied and pasted at the right cell of the new file.
"Code" is the equivalent "ID"
"Name" is in the 2nd column in FileA but it is in the 3d column in FileB.
"Surname " is in the 3d column in FileA but it is in the 2nd column in FileB.
So, for example the second row from FileA will be pasted in FileB as shown:
UPD:
I am using this code to select the range of the rows and paste them to the new file.
Sub ExportRangetoFile()
Dim Rng As Range
Dim WorkRng As Range
Dim lRow As Long, lCol As Long
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
lRow = Range("A" & Rows.Count).End(xlUp).row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set Rng = Range(Cells(lRow, 1), Cells(lRow, lCol))
ActiveSheet.Copy
ActiveSheet.Cells.Clear
Rng.Copy Application.ActiveSheet.Range(Cells(lRow, 1), Cells(lRow, lCol))
Columns("C:C").Cut: Columns("B:B").Insert Shift:=xlToRight
Set xFile = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub
I want to change the code so to create the headers in the new file and allocate the cells of each row in the right column.
UPD: My problem is that my code needs a change. In the new file, I am only getting one row and not all. As a first step, something has to change here :
ActiveSheet.Copy
ActiveSheet.Cells.Clear
Rng.Copy Application.ActiveSheet.Range(Cells(lRow, 1), Cells(lRow, lCol))
and then I will need to search how to create the headers in the new csv file.

Answer 1

I tried modifying your code a bit, and ended up with this macro which I think does what you want, while simplifying the snippet you posted quite a bit. If I misunderstood your requirements in some way, or if there is something which needs further explanation, don't hesitate to ask.
Option Explicit
Sub ExportRangetoFile()
Dim cpFromRng As Range, cpToRng As Range
Dim cpFromWB As Workbook, cpToWB As Workbook
Dim lRow As Long, lCol As Long
Set cpFromWB = ActiveWorkbook
' Set range to copy
With cpFromWB
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
' I assume the top left cell you want to copy from is A1, if that is wrong, change the line below back
Set cpFromRng = Range(Cells(1, 1), Cells(lRow, lCol))
End With
' Create new workbook
Set cpToWB = Workbooks.Add
Set cpToRng = cpToWB.ActiveSheet.Range("A1")
' Copy everything over to the new workbook
cpFromRng.Copy Destination:=cpToRng
' Shuffle columns around
cpToWB.ActiveSheet.Columns("C:C").Cut
cpToWB.ActiveSheet.Columns("B:B").Insert Shift:=xlToRight
' Save as CSV-file
ActiveWorkbook.SaveAs Filename:="C:\Users\a245401\Range.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub