I have created a table mapping the row names in my Destination workbook to row names in my source sheet in the sheet named 'Test'.
I have attached an image showcasing the mapping in columns A and B respectively.
[ATTACH=JSON]{"alt":"Map","data-align":"none","data-attachmentid":"1198495","data-size":"full","title":"Map.PNG"}[/ATTACH]
The destination rows are not successive and there are other rows in between not referring data from the source sheet. The row names in the source sheet are in Column 2 and row names in Destination sheet are in column 1. I need to copy the data from the source sheet rows that have the matching name in the Destination sheet rows as per my mapping from the image attached.
This is my code:
Sub Map()
DestName = "Data Cost Estimate" 'Name of destination sheet
SourceName = "EST Actuals" 'Name of Source sheet
MyDir = "Default directory path"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set Wb = ThisWorkbook
Set HeadWS = Wb.Worksheets("Test")
With HeadWS LastHead = .Cells(.Rows.Count, 1).End(xlUp).Row
Set HeadRange = .Range("A2:A" & LastHead)
ReDim Heads(LastHead - 2) '-1 for header row in header map and -1 for 0 based arrary
Heads = HeadRange.Value
End With
answer = MsgBox("If you want to select a specific file click Yes, if you want to go to default path and If you are not sure, click Cancel", vbYesCancel + vbQuestion, "User Specified Path")
If answer = vbYes Then
MyFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
Set wkb = Workbooks.Open(MyFile, UpdateLinks:=0)
With wkb.Worksheets(SourceName)
.Rows("1:" & HeadRow - 1).EntireRow.Delete
For j = .Cells(1, .Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(.Cells(1, j), Heads, False)) Then
.Columns(j).Delete
Next
HeadRange.Offset(, 1).Copy
.Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
ElseIf answer = vbCancel Then
Msgbox "Do nothing"
Exit Sub
End If
With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
End With
ThisWorkbook.Save
End Sub
I think it would be easier if I write a function for this process, but I am not sure as to how. The table mapping is in columns A,B respectively. Thank you