كيف ادمج الكودين دمج كودين

[jaber77]

Sub ex1()
    On Error Resume Next
    Dim Dept_Row As Integer, Dept_Clm As Integer
    Dim Table1 As Range, Table2 As Range, CL As Range
    
    Set Table1 = Sheet10.Range("A3:A2000")
    Set Table2 = Sheet1.Range("s3:w2000")
    Dept_Row = Sheet10.Range("b3").Row
    Dept_Clm = Sheet10.Range("b3").Column
    
    For Each CL In Table1
        Sheet10.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(CL, Table2, 2, False)
        Dept_Row = Dept_Row + 1
    Next CL

End Sub

Sub ex2()
    On Error Resume Next
    Dim Dept_Row As Integer, Dept_Clm As Integer
    Dim Table1 As Range, Table2 As Range, CL As Range
    
    Set Table1 = Sheet10.Range("A3:A2000")
    Set Table2 = Sheet1.Range("s3:w2000")
    Dept_Row = Sheet10.Range("c3").Row
    Dept_Clm = Sheet10.Range("c3").Column
    
    For Each CL In Table1
        Sheet10.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(CL, Table2, 3, False)
        Dept_Row = Dept_Row + 1
    Next CL

End Sub

 

تم تعديل ديسمبر 6, 2017 بواسطه jaber77

[بن علية حاجي]

السلام عليكم

جرب الكود التالي:

Sub ex()
    
    On Error Resume Next
    Dim Dept_Row1 As Integer, Dept_Clm1, Dept_Row2, Dept_Clm2
    Dim Table1 As Range, Table2, CL1, CL2
    Set Table1 = Sheet10.Range("A3:A2000"): Set Table2 = Sheet1.Range("S3:W2000")
    Dept_Row1 = Sheet10.Range("B3").Row: Dept_Clm1 = Sheet10.Range("B3").Column
    Dept_Row2 = Sheet10.Range("C3").Row: Dept_Clm2 = Sheet10.Range("C3").Column
    
    For Each CL1 In Table1
        Sheet10.Cells(Dept_Row1, Dept_Clm1) = Application.WorksheetFunction.VLookup(CL1, Table2, 2, False)
        Dept_Row1 = Dept_Row1 + 1
    Next CL1
    
    For Each CL2 In Table1
        Sheet10.Cells(Dept_Row2, Dept_Clm2) = Application.WorksheetFunction.VLookup(CL2, Table2, 3, False)
        Dept_Row2 = Dept_Row2 + 1
    Next CL2

End Sub

بن علية حاجي

[jaber77]

نعم استاذي هذا هو المطلوب 

شكرا جزيلا وتقبل تحياتي وأسأل الله العلي القدير ان يحفظك