Open an excel file and copy data based on column headings

[michaelkrtikos]

Hello Everyone,

I would like some help as i am trying to automate a piece of work that i do on a monthly basis involving data being copied from one excel file to another and re-organized based on column headings. Please find some more details below:

The Source file:
This is a csv file containing columns extracted from a system on a monthly basis. Unfortunately, the columns can be in different order each month (most probably the template is changing). The name of the report is also changing every month as it contains the date. For example it can be: Raw_Data_Dec22_12_31.csv. It only contains one sheet but also this sheet has different name each month as it also contains the date.

The Destination file:
The destination file is the file that the VBA code will be placed. The intention is to have a sheet called "Raw Data" with headings only (the columns of the source file but in the correct order), in which the corresponding data from the source file will be pasted.

The request is:
To have a button in the destination file which when pressed, an openfiledialog will open for me to choose the source file. It has to be with an openfiledialog because the name of the source file is variable and i cannot use the path to it. When opened, the code should parse the first sheet and copy / paste the data from the source file to the destination file on sheet "Raw Data" under each corresponding heading (headings are from A1).

I have the code to open the file as follows:

Dim FileName As String
Dim SourceWbk As Workbook
Dim DestinWbk As Workbook

Set DestinWbk = ThisWorkbook

Application.ScreenUpdating = False

FileName = Application.GetOpenFilename(FileFilter:="CSV files (*.csv), *.csv", Title:="Select a File")
If FileName = "False" Then Exit Sub
Set SourceWbk = Workbooks.Open(FileName)


`code to parse the SourceWbk.sheets(1) and copy/paste to the corresponding column of the DestinWbk.sheets("Raw data")


SrcWbk.Close False

Application.ScreenUpdating = True
End Sub

After looking at the available solutions, i have found this example on thread: VBA code for copy paste data based on column headers.

Public Sub CopyProjectName()
Dim sourceWS As Worksheet, targetWS As Worksheet
Dim lastCol As Long, lastRow As Long, srcRow As Range
Dim found1 As Range, found2 As Range, j As Long, Cr1 As String

Set sourceWS = Workbooks("Workbook1.xlsm").Worksheets("Sheet1") 'Needs to be open
Set targetWS = Workbooks("Workbook2.xlsm").Worksheets("Sheet1") 'Needs to be open

With sourceWS
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For j = 1 To lastCol
Cr1 = .Cells(1, j).Value
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

If Not found1 Is Nothing Then
lastCol = targetWS.Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRow = targetWS.Range("A1", targetWS.Cells(1, lastCol))
Set found2 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

If Not found2 Is Nothing Then
lastRow = .Cells(Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Copy
found2.Offset(1, 0).PasteSpecial xlPasteAll
End If
End If
Next j
End With
End Sub

Although the above example handles the copy/paste on the correct columns, it requires both files to be open (which i don't want) and also, it is using a static Workbook name and sheet for both the source and the destination file which i don't have. Somehow i am trying to put together these pieces of code but i am unable to do so.

Could anyone please help me?

Thank you very much