Hi All,
I am a intermediate learner to vba programing and came up with a task to copy a cell value from workbook1 of sheet1 to workbook2 of sheet1 by matching up with multiple criteria and copy the Sort reference(workbook1) column cell value to Notes And Assumption(workbook2) cells.
Copy a cell value of column Sort Reference from workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts to column Notes And Assumptions cell by matching up with multiple criteria.
Columns to match with workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts are below:-
Workbook RMT v8.0.2 - Huawei V1.2.xlsm Workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb
RMT v8.0.2 - Huawei V1.2.xlsm --> RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb
Functional Group matches with--------------------> Primary Skills
Master Role Code matches with--------------------> Master Role Code
Region/Country matches with---------------------> Work Required Country
Sort Reference(Workbook1)-----------------------> Notes And Assumptions(Workbook2)
(Note:- If all above criteria matched then matched row of column Sort Reference cell value pasted to the matched row to the column Notes And Assumptions)
I tries below code but the k value is not increasing.
Thank you for help in advance. It would be great help.
I am a intermediate learner to vba programing and came up with a task to copy a cell value from workbook1 of sheet1 to workbook2 of sheet1 by matching up with multiple criteria and copy the Sort reference(workbook1) column cell value to Notes And Assumption(workbook2) cells.
Copy a cell value of column Sort Reference from workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts to column Notes And Assumptions cell by matching up with multiple criteria.
Columns to match with workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts are below:-
Workbook RMT v8.0.2 - Huawei V1.2.xlsm Workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb
RMT v8.0.2 - Huawei V1.2.xlsm --> RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb
Functional Group matches with--------------------> Primary Skills
Master Role Code matches with--------------------> Master Role Code
Region/Country matches with---------------------> Work Required Country
Sort Reference(Workbook1)-----------------------> Notes And Assumptions(Workbook2)
(Note:- If all above criteria matched then matched row of column Sort Reference cell value pasted to the matched row to the column Notes And Assumptions)
I tries below code but the k value is not increasing.
Code:
Sub sortref()
Dim wbk, wbk1 As Workbook
Dim sht, sht1 As Worksheet
Dim i, j, k, n As Integer
Dim FGroup, PSkills, RegCoun, WrCoun, MRCode, RCode As String
Application.DisplayAlerts = False
Set wbk = Workbooks.Open(Filename:="C:\Users\Amit\desktop\RMT Changes\RMT v8.0.2 - Huawei V1.2.xlsm")
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Sheets("Input").Activate
Set sht = ThisWorkbook.Worksheets("MUForecasts")
Set sht = Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Worksheets("Input")
Set sht1 = Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Worksheets("MUForecasts")
Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Sheets("MUForecasts").Activate
n = Sheets("MUForecasts").Range("A250").End(xlUp).Row
For i = 13 To wbk.Sheets("Input").Range("C250").End(xlUp).Row
For k = 3 To n
'sht.Range ("H" & i)
FGroup = sht.Range("H" & i) '= Sheets("Input").Range("H" & i).Value
PSkills = sht1.Range("R" & k) '= Sheets("MUForecasts").Range("R" & k).Value
RegCoun = sht.Range("L" & i)
WrCoun = sht1.Range("P" & k)
MRCode = sht.Range("X" & i)
RCode = sht1.Range("Q" & k)
If FGroup = PSkills Then
If RegCoun = WrCoun Then
If MRCode = RCode Then
sht.Cells(i, 2).Value = sht1.Cells(k, 27).Value
sht1.Cells(k, 27).PasteSpecial Paste:=xlPasteValues
End If
End If
End If
Next
Next
wbk.Close
Set wbk = Nothing
Set sht = Nothing
Set sht1 = Nothing
Application.DisplayAlerts = True
End Sub
Thank you for help in advance. It would be great help.
Last edited by a moderator: