Copy specific cells based on value in the same row in sheet1(table1) and paste into sheet2(table2) n-CodePudding

This code works, but it puts the values at the bottom of Sheet2(Table2), instead of next available row in table2. Any suggestions would be appreciated. Thanks

https://drive.google.com/file/d/19fZ6GLGtVNd13I-GTgLVjnfKlzrwx05U/view?usp=sharing

Sub Macro()

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Sheets("Sheet2")
  Dim LastRow As Long
  Dim s As Long
  Dim myRow As Long
          
                   
      s = ws.Range("A" & Application.Rows.Count).End(xlUp).Row
              
      LastRow = Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row
                     
          For myRow = 2 To LastRow
              If Sheets("Sheet1").Cells(myRow, "I") = "INACTIVE" Then
                 ws.Range("A" & s   1) = Sheets("Sheet1").Cells(myRow, "A")
                 ws.Range("B" & s   1) = Sheets("Sheet1").Cells(myRow, "B")
                 ws.Range("C" & s   1) = Sheets("Sheet1").Cells(myRow, "C")
                 ws.Range("D" & s   1) = Sheets("Sheet1").Cells(myRow, "I")
              End If
          Next myRow

End Sub

CodePudding user response：

Copying Data From One Excel Table to Another

Dealing with Excel tables in VBA can be quite tricky. This is a simple user-friendly version. You could dive much deeper into it by using (an array of) the table headers in the loop and whatnot.

Option Explicit

Sub Macro()

    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Sheet1")
    Dim stbl As ListObject: Set stbl = sws.ListObjects("Table1")
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Sheet2")
    Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table2")

    Dim sCell As Range
    Dim srrg As Range
    Dim drrg As Range
    Dim r As Long
    
    For Each sCell In stbl.ListColumns("Status").DataBodyRange
        r = r   1
        If StrComp(CStr(sCell.Value), "INACTIVE", vbTextCompare) = 0 Then
            Set srrg = stbl.ListRows(r).Range
            Set drrg = dtbl.ListRows.Add.Range
            drrg.Cells(1).Value = srrg.Cells(1).Value
            drrg.Cells(2).Value = srrg.Cells(2).Value
            drrg.Cells(3).Value = srrg.Cells(3).Value
            drrg.Cells(4).Value = srrg.Cells(9).Value
        End If
    Next sCell

End Sub

CodePudding user response：

the below code should work as s variable is inside the loop.

P.S.

Updated the code to match your example. Also, the sheet2 has table, so the last row was not detected correctly by End(xlUp).Row

The problem was also with myRow =2

Sub Macro()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim LastRow As Long
Dim s As Long
Dim myRow As Long
          
LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row
           
For myRow = 1 To LastRow
    s = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row   1
    If ws1.Cells(myRow, "I") = "INACTIVE" Then
        ws.Range("A" & s & ":C" & s) = ws1.Range("A" & myRow & ":C" & myRow).Value
        ws.Range("D" & s) = "INACTIVE"
    End If
Next myRow
                  
MsgBox "OK"

End Sub