I want to merge two tables from two different workbooks and that is what I managed to do so far.

The code I have is good to look for the rows that have active in them but it keeps empty rows in between the new table. Meaning, ID 1 and 4 are active but there is two rows non active and unknown so it wont copy them and I will have similar to the picture

.

Could someone help me to add a line so it does not leave an empty rows?

Also I would like to add a line so it look for the ID in another table and copy the row and bring it to the new table.

Option Explicit

Sub Test()

Dim Cell As Range

With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("G1:G" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        If Cell.Value = "Active" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets(4).Rows(Cell.Row)
            
        End If
    Next Cell End With

End Sub

CodePudding user response：

Let me guess this right:

1. Remove empty rows?
2. Bring the same ID from the second table to make the merge of two tables?
3. Report any missing numbers or text?

CodePudding user response：

See this post

       'This code to delete the empty rows in between the new table'
    

Sub DeleteBlankRows()
    On Error Resume Next
        Range("A3:A1000000").Select
        Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub





'this code is to bring the matching IDs from two different workbooks'



Sub TestGridUpdate()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim TestGridFound As Boolean
    Dim r As Range
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet4")
    Set ws2 = ThisWorkbook.Worksheets("Sheet6")
    
    ' Look for TestGrid worksheet
    TestGridFound = False
    For Each ws In Worksheets
        If ws.Name = "TestGrid" Then TestGridFound = True
    Next
    
    'If TestGrid is found then use it else create it
    If TestGridFound Then
        Set ws3 = ThisWorkbook.Worksheets("TestGrid")
        ws3.Cells.Clear
    Else
        Set ws3 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws3.Name = "TestGrid"
    End If

    ' Copy ws1 to ws3 (TestGrid)
    ws3.Range(ws1.UsedRange.Address).Value = ws1.UsedRange.Value
    
    ' Add ws2 details to ws3 (TestGrid)
    For Each r In ws3.UsedRange.Rows
        ID = r.Cells(, 1).Value
        iRow = Application.Match(ID, ws2.UsedRange.Columns(1), 0)
        If Not IsError(iRow) Then ws2.Range("B" & iRow & ":U" & iRow).Copy ws3.Range("Q" & r.Row)
    Next

End Sub