Copy specific cells based on value in the same row in sheet1(table1) and paste into sheet2(table2) next available row

[pstamper]

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

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

 

[DacEasy]

Hi, your issue sounds similar to the one found here - Pasting in transpose
If that is not the case, upload an image of the table and I will test it.

 

[pstamper]

Hi, your issue sounds similar to the one found here - Pasting in transpose
If that is not the case, upload an image of the table and I will test it.

Test Book_Copy&Paste Example.xlsm
	A	B	C	D	E	F	G	H	I
5	Emp No.	Last Name	First Name	Middle Name	Sex	Married	Phone No.	Address	Status
6	1234	ONE	TEST	ME	MALE	YES	(555) 555-5555	US	ACTIVE
7	1235	TWO	TEST	ME	FEMALE	YES	(777) 777-7777	US	ACTIVE
8	1236	THREE	TEST	ME	MALE	NO	(888) 888-8888	US	INACTIVE
9	1237	FOUR	TEST	ME	MALE	YES	(222) 222-2222	US	ACTIVE
Sheet1

Test Book_Copy&Paste Example.xlsm
	A	B	C	D
1	Emp No.	Last Name	First Name	Status
2
Sheet2

 

[pstamper]

Test Book_Copy&Paste Example.xlsm
	A	B	C	D	E	F	G	H	I
5	Emp No.	Last Name	First Name	Middle Name	Sex	Married	Phone No.	Address	Status
6	1234	ONE	TEST	ME	MALE	YES	(555) 555-5555	US	ACTIVE
7	1235	TWO	TEST	ME	FEMALE	YES	(777) 777-7777	US	ACTIVE
8	1236	THREE	TEST	ME	MALE	NO	(888) 888-8888	US	INACTIVE
9	1237	FOUR	TEST	ME	MALE	YES	(222) 222-2222	US	ACTIVE
Sheet1

Test Book_Copy&Paste Example.xlsm
	A	B	C	D
1	Emp No.	Last Name	First Name	Status
2
Sheet2

Test Book_Copy&Paste Example.xlsm

drive.google.com

 

[DacEasy]

Ok, this was a rough one. Your code is perfect. It looks like the table has two rows when you build it, the header and then first row. Since "s" is 2, ws.Range("A" & s + 1) is 2 + 1, so it's placing the data on row 3, outside the table. A simple fix, see below:

s = ws.Range("A" & Application.Rows.Count).End(xlUp).Row
If Range("A" & s) = "" And Range("B" & s) = "" Then 'If the lastrow is missing the No. and Last Name from the table, let's use it.
s = s - 1
End If

 

[Alex Blakenburg]

If your issue is that you are getting the last row in the table instead of the last empty row in the table, then try this:

Sub LastUsedRow()
    Dim s As Long
    Dim lstObj As ListObject
    Set lstObj = Worksheets("Sheet2").ListObjects("Table2")
    
    With lstObj
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        s = Worksheets("Sheet2").Range("Table2").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    End With

End Sub

 

[pstamper]

This is the solution I was looking for. Thanks to VBasic2008.

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