How to modify existing VBA to move rows from one sheet to another

[ksantos16]

I inherited a workbook that has a VBA code to move items that are marked "Closed" in column D to another worksheet that has been pre-prepared. The request is to use this workbook for another, similar purpose. I had to add a column, which didn't seem to affect things so long as I made that same change to the new worksheet.

My two major issues are:

1) The new data will have many more rows of information than the original form and when I add rows, they do not seem to be recognized and are not moved when the command button is clicked.
2) The code as written doesn't transfer information from column A to the new worksheet.

When I click the command button to move the information, I receive this error: "Run-time error '1004': To do this, all the merged cells need to the be the same size." And it gives me the option to "End", "Debug" or "Help". The "Continue" button is greyed out. When I click any of them, it will still move some of the rows the information to the new sheet.

I have attempted to make all the cells the same size and still get this error, so I don't know if there is something else that I'm missing.

The VBA code as currently written is as follows:

Sub move_closed()

Dim Status, Rng As Range
Application.ScreenUpdating = False

begin:
Set Rng = Sheets("Open").Range("D8:D57") 'sets the range to use
    For Each ItemStatus In Rng
    
    If ItemStatus = "" Then GoTo jmp
    
    If ItemStatus = "Closed" Then
        current_row = ItemStatus.Row
        closed_row = "B" & current_row & ":AK" & current_row
        Range(closed_row).Select
        Selection.Copy
        Sheets("Closed").Select
    
        Range("B58").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    
        Sheets("Open").Select
        Range(closed_row).Select
        Selection.Delete Shift:=xlUp
        Range("B56:AK56").Select
        Selection.AutoFill Destination:=Range("B56:AK57"), Type:=xlFillDefault
        GoTo begin
    End If
    Next

jmp:
Application.ScreenUpdating = True
End Sub

Here is a portion of my spreadsheet:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK
6	Issue Description											Action To Be Taken																				Performance Tracker
7	8D#	Date Opened		Status		Description						Action To Be Taken									Progress						Champion	Person Responsible		Date Due		Date Completed			Complete On Time
8	10681	1/11/16		Closed		found damage to housing on 24315 and 24357						to complete QRQC															AS	KS		1/21/16		1/21/16			Yes
9	10681	1/11/16		Open		found damage to housing on 24315 and 24357						Add sensor to driver slide															AS	AS		2/5/16
10	10682	1/11/16		Open		found adjuster 24569 stuck in the fully retracted position						Reviewing the returned part									In Q						PB	PB		1/29/16
11	10680	1/6/16		Closed		Rust prior to 96 hours						Look at Plating spec									We passed plating spec						MG	MG		1/22/16		1/22/16			Yes
Open

I have tried to modify this by changing the ranges to reflect the new ranges, but I have no success. I appreciate any help.

Thanks!

 

[Gingertrees]

Merged cells are the road to the Dark Side.
In all seriousness, it is a royal pain in the neck to do anything with merged cells. I highly recommend never using them unless you're doing a purely viusal worksheet. Moving them with code will almost always be fraught with problems.

My best recommendation would be to change column sizes and re-do this workbook with no merged cells. Royal pain, I'm sure, but that's what I'd do. If it's an option. Otherwise... No good suggestions. Sorry.