DO NOT Copy Data Under Table/ Copy Data from Table to Table

[rorobear]

Hello Everyone,

As always, any assistance is greatly appreciated! In the workbook, I have to sheets (sheet1 and sheet2) and a button. When clicked, every row in Sheet1 with the cell value “Complete” is deleted and copied to Sheet2. The data is in tables (Table1 and Table2). The problem is when it copies over, it doesn’t remain in a table format, but rather copies the data under the table. What I want is for the data to copy from table to table. I’ve attached the sample workbook. Thank you again!
roro

  
Sub MoveRow_DeleteOriginal()
Dim rg As Range
Dim xc As Range
Dim p As Long
Dim q As Long
Dim r As Long
p = Worksheets("Sheet1").UsedRange.Rows.Count
q = Worksheets("Sheet2").UsedRange.Rows.Count
If q = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then q = 0
End If
Set rg = Worksheets("Sheet1").Range("G1:G" & p)
On Error Resume Next
Application.ScreenUpdating = False
For r = 1 To rg.Count
     If CStr(rg(r).Value) = "Complete" Then
         rg(r).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & q + 1)
         rg(r).EntireRow.Delete
            If CStr(rg(r).Value) = "Complete" Then
               r = r - 1
           End If
           q = q + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

[Aussiebear]

What defines a "table"?

[rorobear]

The two excel tables in the workbook, Table1 and Table2

[p45cal]

If you run the following macro (which is yours but with a few additional lines to show what's what) step by step with F8 on the keyboard, you'll soon see what's going wrong. You think the usedrange always starts at the top row of a sheet but it doesn't.

Sub MoveRow_DeleteOriginal()
Dim rg As Range
Dim xc As Range
Dim p As Long
Dim q As Long
Dim r As Long
Application.Goto Worksheets("Sheet1").UsedRange
p = Worksheets("Sheet1").UsedRange.Rows.Count
Application.Goto Worksheets("Sheet2").UsedRange
q = Worksheets("Sheet2").UsedRange.Rows.Count
If q = 1 Then
  If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then q = 0
End If
Set rg = Worksheets("Sheet1").Range("G1:G" & p)
Application.Goto rg
'On Error Resume Next
'Application.ScreenUpdating = False
For r = 1 To rg.Count
  Application.Goto rg(r)
  If CStr(rg(r).Value) = "Complete" Then
    Application.Goto rg(r).EntireRow
    Application.Goto Worksheets("Sheet2").Range("A" & q + 1)
    rg(r).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & q + 1)
    Application.Goto rg(r).EntireRow
    rg(r).EntireRow.Delete
    Application.Goto rg(r)
    If CStr(rg(r).Value) = "Complete" Then
      r = r - 1
    End If
    q = q + 1
  End If
Next
Application.ScreenUpdating = True
End Sub

Try this instead:

Sub blah()
Dim rngToCopy As Range, tbl2
Set tbl2 = Range("Table2").ListObject
With Range("Table1").ListObject
  .Range.AutoFilter Field:=.ListColumns("Status").Index, Criteria1:="Complete" 'filter Status field for "Complete"
  On Error Resume Next 'next line errors if there's nothing to move.
  Set rngToCopy = .DataBodyRange.SpecialCells(xlCellTypeVisible)
  On Error GoTo 0 'restore normal error reporting
  If Not rngToCopy Is Nothing Then ' only if something needed to mode:
    rngToCopy.Copy tbl2.ListColumns(1).Range.Cells(tbl2.ListColumns(1).Range.Count).Offset(1) 'copy the rows to bottom of other table.
    If .ShowAutoFilter Then .Range.AutoFilter 'remove all filters to allow deletion of rows
    Intersect(rngToCopy.EntireRow, .DataBodyRange).Delete 'actually delete the rows of the table.
    .Range.AutoFilter 'reinstate the filter buttons (but with no filter at all).
  Else 'nothing to move so:
    .Range.AutoFilter Field:=.ListColumns("Status").Index 'remove "Complete" autofilter from Status field.
  End If
End With
End Sub

See attached.

[Artik]

I think you will find the answer here: https://www.excelforum.com/excel-pro...ml#post5779232

rorobear please remember for the future that the obligation to disclose cross-post exists on all forums, including here.

Artik

[p45cal]

I think you will find the answer here

Grrrr.

[rorobear]

p45Cal,

thank you kindly, this works exactly how i want. thank you for the support on this.

v/

[rorobear]

Artik,

my apologizes, my original post was here. didn't mean to cause any confusion. i'm very grateful for all the support i get in these forums.

[Aussiebear]

Artik,

my apologizes, my original post was here. didn't mean to cause any confusion. i'm very grateful for all the support i get in these forums.

The VBA community with regard to those who frequent and participate within forums is relatively small. Members here are clearly also members elsewhere so cross posting is easily noticed, and has a flow on effect whereby some of the more serious contributors will simply disregard any further input from a User. Rorobear, please don't be that person who gains a reputation for being a cross poster.

It matters little, whether you initially posted here or elsewhere, please indicate any cross post so that others (if they are interested) can follow along.