Q: Is ther a quicker way or clever way to do 2 for each? I want to add cell value from one table to another. the first table contains about 110 000 rows (tabCDL) and the other about 37 000 rows (tabEMP). It takes about one hour to do right now and I need to do it faster.
Public Sub MergeColumnEMP()

    'Merge

    Dim cel, cel2, rngCDL, rngEMP As Range
    Dim shtCDL, shtEMP As Worksheet
    Dim LastRowCDL, LastRowEMP As Long
    
    Set shtCDL = Sheets("CEDULE")
    Set shtEMP = Sheets("EMPRUNT")
    LastRowCDL = shtCDL.ListObjects("TabCEDULE").Range.Rows.Count
    LastRowEMP = shtEMP.ListObjects("TabEMP").Range.Rows.Count
    Set rngCDL = Sheets("CEDULE").Range("H2:H" & LastRowCDL)
    Set rngEMP = Sheets("EMPRUNT").Range("C2:C" & LastRowEMP)
    
    For Each cel In rngCDL
    
        For Each cel2 In rngEMP
        
            If cel.Value = cel2.Value Then
            
                'amount
                Sheets("CEDULE").Range("I" & cel.Row).Value = Sheets("EMPRUNT").Range("D" & cel2.Row).Value
                'Date dstart
                Sheets("CEDULE").Range("J" & cel.Row).Value = Sheets("EMPRUNT").Range("H" & cel2.Row).Value
                'Date end
                Sheets("CEDULE").Range("K" & cel.Row).Value = Sheets("EMPRUNT").Range("I" & cel2.Row).Value
             
                Exit For
                
            End If
        
        Next cel2
    
    Next cel
    
    Debug.Print "DONE merging"

End Sub


A: Try the next way, please. It uses arrays and should be very fast. Not tested, but it should work, if I did not messed anything up regarding the involved ranges:
Sub MergeColumnEMP() 'unique in EMP, not unique in CEDULE
    Dim arrCDL, arrEMP, rngCopy As Range, i As Long, j As Long
    Dim shtCDL As Worksheet, shtEMP As Worksheet
    Dim LastRowCDL As Long, LastRowEMP As Long
    
    Set shtCDL = Sheets("CEDULE")
    Set shtEMP = Sheets("EMPRUNT")
    LastRowCDL = shtCDL.ListObjects("TabCEDULE").Range.rows.Count
    LastRowEMP = shtEMP.ListObjects("TabEMP").Range.rows.Count
    
    arrCDL = shtCDL.Range("H2:K" & LastRowCDL).value            'h
    arrEMP = Sheets("EMPRUNT").Range("C2:I" & LastRowEMP).value 'c
    
    For i = 1 To UBound(arrCDL)
        For j = 1 To UBound(arrEMP)
            If arrCDL(i, 1) = arrEMP(j, 1) Then
                arrCDL(i, 2) = arrEMP(j, 2)
                arrCDL(i, 3) = arrEMP(j, 5)
                arrCDL(i, 4) = arrEMP(j, 6)
                Exit For
            End If
        Next j
    Next i
    shtCDL.Range("H2").Resize(UBound(arrCDL), UBound(arrCDL, 2)).value = arrCDL
    
    MsgBox "DONE merging"
End Sub

Edited:
Please, also test the next code, which should be faster:
Sub MergeColumnEMPLast() 'unique in EMP, not unique in CEDULE
    Dim arrCDL, arrEMP, rngCopy As Range, i As Long, j As Long
    Dim shtCDL As Worksheet, shtEMP As Worksheet
    Dim LastRowCDL As Long, LastRowEMP As Long
    Dim dict As New Scripting.Dictionary, iMatch As Variant
    
    Set shtCDL = Sheets("CEDULE")
    Set shtEMP = Sheets("EMPRUNT")
    LastRowCDL = shtCDL.ListObjects("TabCEDULE").Range.rows.Count
    LastRowEMP = shtEMP.ListObjects("TabEMP").Range.rows.Count
    
    arrCDL = shtCDL.Range("H2:K" & LastRowCDL).value 'h
    arrEMP = shtEMP.Range("C2:I" & LastRowEMP).value 'c
    
    For i = 1 To UBound(arrCDL)
        If dict.Count > 0 Then iMatch = Application.match(arrCDL(i, 1), dict.Keys, 0)
        If Not IsError(iMatch) Then
            If dict.Count > 0 Then
               If iMatch <> dict.Count Or (iMatch = dict.Count And arrCDL(i, 1) = dict.Keys(dict.Count - 1)) Then
                  arrCDL(i, 2) = dict.items(iMatch - 1)(0)
                  arrCDL(i, 3) = dict.items(iMatch - 1)(1)
                  arrCDL(i, 4) = dict.items(iMatch - 1)(2)
                  GoTo OverIteration
               End If
            End If
        End If
        For j = 1 To UBound(arrEMP)
            If arrCDL(i, 1) = arrEMP(j, 1) Then
                arrCDL(i, 2) = arrEMP(j, 2)
                arrCDL(i, 3) = arrEMP(j, 6)
                arrCDL(i, 4) = arrEMP(j, 7)
                dict.Add arrCDL(i, 1), Array(arrEMP(j, 2), arrEMP(j, 6), arrEMP(j, 7))
                Exit For
            End If
        Next j
OverIteration:
    Next i
    shtCDL.Range("H2").Resize(UBound(arrCDL), UBound(arrCDL, 2)).value = arrCDL
    
    MsgBox "DONE merging"
End Sub

I am just curious how much it takes for your range...

A: With a Dictionary Object as a look-up
Option Explicit
Public Sub MergeColumnEMP()

    'Merge
    Dim wb As Workbook
    Dim shtCDL As Worksheet, shtEMP As Worksheet
    Dim cel As Range, rngCDL, rngEMP As Range
    Dim LastRowCDL As Long, LastRowEMP As Long, t0 As Single
    t0 = Timer
    
    Set wb = ThisWorkbook
    Set shtCDL = wb.Sheets("CEDULE")
    LastRowCDL = shtCDL.ListObjects("TabCEDULE").Range.Rows.Count
    Set rngCDL = shtCDL.Range("H2:H" & LastRowCDL)
    
    Set shtEMP = wb.Sheets("EMPRUNT")
    LastRowEMP = shtEMP.ListObjects("TabEMP").Range.Rows.Count
    Set rngEMP = shtEMP.Range("C2:C" & LastRowEMP)
    
    Dim dict As Object, key As String, r As Long
    Set dict = CreateObject("Scripting.Dictionary")

    ' fill dictionary with rowno as value
    For Each cel In rngEMP
        key = Trim(cel)
        If Len(key) > 0 Then dict(key) = cel.Row
    Next

    ' compare using dictionary
    For Each cel In rngCDL ' col H
        key = Trim(cel)
        If Len(key) > 0 And dict.exists(key) Then
            r = dict(key)
            With shtCDL
                ' update
                cel.Offset(0, 1) = shtEMP.Range("D" & r).Value ' I amount
                cel.Offset(0, 2) = shtEMP.Range("H" & r).Value ' J Date dstart
                cel.Offset(0, 3) = shtEMP.Range("I" & r).Value ' K Date end
            End With
         End If
    Next
    
    MsgBox "DONE merging", vbInformation, "Duration " & Int(Timer - t0) & " seconds"
End Sub

