Move part of table to new tab

[rjplante]

I have a table that has the number of columns defined when it is opened for the first time. Column A is always a reference column and the number of columns is entered into cell CF1 and starts in column B. If the user enters 8 columns, there will be nine columns to the table. Some rows will have a single cell with data in it, and others will have multiple cells containing data. I have the data sorted from largest to smallest with respect to number of occurrences of data in the row. I have inserted a blank row where the data has only a single data occurrence in the row. I want to grab the data from A to the end of the table and move it to sheet 2 and insert it at cell A5. My current code and table example appears below. I just need help with the moving the data part. The last two lines are my problem. The last line before the end sub gives me an error: "Run-Time error '438': Object doesn't support this property or method". I would like to just move the data and not copy and paste it, as I want the data completely removed from the first sheet.

Macro:

Sub SORT_AND_MOVE()

Dim LastRow As Long
Dim MC As Long
Dim LC As Range

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Cells(5, Range("CF1") + 3).Select

Set LC = Cells(LastRow, ActiveCell.Column)

MC = Range("CF1").Value

'   Add formula to outside of table
ActiveCell.Formula = "=COUNTIF(" & ActiveCell.Offset(0, -(MC + 1)).Address(0, 0) & ":" & ActiveCell.Offset(0, -2).Address(0, 0) & "," & ActiveCell.Offset(0, -(MC + 2)).Address(0, 0) & ")"

Range(ActiveCell.Address(0, 0)).AutoFill Destination:=Range(ActiveCell.Address(0, 0) & ":" & LC.Address(0, 0)), Type:=xlFillCopy

'   Sort Largest to smallest

Range("A5:" & LC.Address(0, 0)).Select

ActiveWorkbook.Worksheets("Block Tracking Multiple").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Block Tracking Multiple").Sort.SortFields.Add2 Key _
        :=Range(Cells(5, Range("CF1") + 3).Address(0, 0) & ":" & LC.Address(0, 0)), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Block Tracking Multiple").Sort
        .SetRange Range("A5:" & LC.Address(0, 0))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'   Enter row between multiple and single entry rows

Cells(4, Range("CF1") + 3).Select

Do Until ActiveCell.Value = 1
    ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.EntireRow.Insert

'   Move Single entry rows to second Single Entry Tab
ActiveCell.Offset(1, -(Range("CF1") + 2)).Select

Sheets("Block Tracking Multiple").Range(ActiveCell.Address(0, 0) & ":" & LC.Address(0, 0)).Copy

Sheets("Block Tracking Single Entry").Range("A5").Paste

End Sub

Table:

Panel Tracking Sheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K
3	Reference Row	Panel 1	Panel 2	Panel 3	Panel 4	Panel 5	Panel 6	Panel 7	Panel 8
5	654		654		654	654					3
6	1054	1054		1054	1054						3
7	1215	1215	1215			1215					3
8	1215A			1215A	1215A						2
9	1218			1218				1218			2
10	1407					1407			1407		2
11	1509	1509						1509			2
12	1604	1604				1604					2
13	1776				1776	1776					2
14	1854					1854	1854				2
15	1854A				1854A		1854A				2
16	1907	1907						1907			2
17	1909		1909	1909							2
18
19	907	907									1
20	907A		907A								1
21	1209	1209									1
22	1303	1303									1
23	1513				1513						1
24	1604A							1604A			1
25	1604B			1604B							1
26	1796						1796				1
27	1905								1905		1
28	2102						2102				1
29	2104							2104			1
Block Tracking Multiple

Cell Formulas
Range	Formula
K5:K17,K19:K29	K5	=COUNTIF(B5:I5,A5)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B3:AZ3	Cell	does not contain a blank value	text	NO
A3:AZ4	Cell	contains a blank value	text	NO

 

[Radoslaw Poprawski]

will this work 4 you?
it a formula not a macro tho.

Book6
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Reference Row	Panel 1	Panel 2	Panel 3	Panel 4	Panel 5	Panel 6	Panel 7	Panel 8
2
3	654		654		654	654					907	907	0	0	0	0	0	0	0
4	1054	1054		1054	1054						907A	0	907A	0	0	0	0	0	0
5	1215	1215	1215			1215					1209	1209	0	0	0	0	0	0	0
6	1215A			1215A	1215A						1303	1303	0	0	0	0	0	0	0
7	1218			1218				1218			1513	0	0	0	1513	0	0	0	0
8	1407					1407			1407		1604A	0	0	0	0	0	0	1604A	0
9	1509	1509						1509			1604B	0	0	1604B	0	0	0	0	0
10	1604	1604				1604					1796	0	0	0	0	0	1796	0	0
11	1776				1776	1776					1905	0	0	0	0	0	0	0	1905
12	1854					1854	1854				2102	0	0	0	0	0	2102	0	0
13	1854A				1854A		1854A				2104	0	0	0	0	0	0	2104	0
14	1907	1907						1907
15	1909		1909	1909
16
17	907	907
18	907A		907A
19	1209	1209
20	1303	1303
21	1513				1513
22	1604A							1604A
23	1604B			1604B
24	1796						1796
25	1905								1905
26	2102						2102
27	2104							2104
28
Sheet1

Cell Formulas
Range	Formula
K3:S13	K3	=INDIRECT(ARRAYTOTEXT(FILTER(ADDRESS(($A$3:$A$27=0)*(ROW(A3:$A$27)+1),1,1),NOT(ISERROR(ADDRESS(($A$3:$A$27=0)*ROW(A3:$A$27),1,1)))))&":"&ADDRESS(ROWS(A1:A27),COUNTA(A1:I1)))
Dynamic array formulas.

 

[rjplante]

Although it is an awesome formula, and thank you for the suggestion, I need to have this data moved and not duplicated.

 

[Radoslaw Poprawski]

then, you can try implementing this into ur macro.
themn copy it as values
delete original range