VBA: Copy data from every other row, paste it in previous row, delete copied row

[JohnJames]

Hi all!

A team I work with sends us reports that we want to put in a database, unfortunately the data for one entry is on multiple lines and it had data that was uneeded. I figured out how to delete the unneeded data and get rid of the blank spaces, just having trouble with the last part which is copying the data in every other row, pasting it in the previous row then deleting the copied row. Fig.1 is what I have currently, I want my data to look like Fig.2.

I found the following code, but don't know how I could make this work for x amount of rows or my range:

Set Rng = Range("B7")
Range(Rng.Address).Offset(-1, 0).Value = Rng.Value

Fig.1

dataR1
	data11	data12	data13	data14	data15	data16
dataR2
	data21	data22	data23	data24	data25	data26
dataR3
	data31	data32	data33	data34	data35	data36

Fig.2

dataR1 data11 data12 data13 data14 data15
dataR2 data21 data22 data23 data24 data25
dataR3 data31 data32 data33 data34 data35

Any help would be greatly appreciated!

[mehmetcik]

Record yourself selecting range A1:A18

Then selecting Home, Find, Goto Special, Blanks

then Right clicking on a selected cell

then selecting Delete, Entire Row.

You will get this:

    Range("A1:A18").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

Which can be reduced to:

    Range("A1:A18").SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

[Sintek]

Something like this...

Option Explicit
Sub JohnJames()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -2
    Range("B" & i & ":G" & i).Copy Range("B" & i - 1)
    Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub

[JohnJames]

Thanks so much Sintek! this is what I needed, just getting the following error when I run it though

Run-time error '1004' : Method 'Range' of object'_Global' failed

I know it has to do with Range, but B:G is the range on the sheet, so don't understand why it's doing this.

[Sintek]

I'm thinking you should specify the sheet....that works for activeSheet only

With Sheets("YourSheetName")
    For i = .Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -2
        .Range("B" & i & ":G" & i).Copy .Range("B" & i - 1)
        Rows(i).Delete
    Next i
End With

Thanks for rep +

[JohnJames]

You're welcome, sintek. I figured out what the issue was by debugging.

When the For loop hits 1, the error occurs so I changed the code to exit the loop when I= 1

Option Explicit
Sub JohnJames()
Dim i As Long
Application.ScreenUpdating = False
With Sheets("DBAMonthly")
    For i = .Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -2
    
    
        If i <> 1 Then
        
        
        .Range("B" & i & ":G" & i).Copy .Range("B" & i - 1)
        Rows(i).Delete
        
        
        End If
        
        
    Next i
End With
Application.ScreenUpdating = True
End Sub

Thanks for all the help!

[Sintek]

Nice one John..Did not see that coming...
perhaps this could also solve?

For i = .Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -2

[JohnJames]

Thanks sintek. That works as well.