Insert blank row after paste in VBA

[Davebro]

I have the following VBA to copy cells into a sheet 2, is there any way that when I paste it inserts a blank row after the paste?


Sub copycolumns()
Dim lastrow As Long, erow As Long

lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Sheet1.Cells(i, 10) = "Home" And Sheet1.Cells(i, 1) > 2 Then
Sheet1.Cells(i, 1).Copy
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 1)

Sheet1.Cells(i, 2).Copy
Sheets("Sheet2").Cells(erow, 2).PasteSpecial xlPasteValues

Sheet1.Cells(i, 3).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 3)

Sheet1.Cells(i, 10).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 4)

End If
Next i

Application.CutCopyMode = False
Sheet2.Columns.AutoFit
Range("A1").Select

End Sub

 

[Davebro]

I don't understand what you are saying in your last post.

What you asked for was

and later


If you had data down to A5 then

Sheet2.Cells(Rows.Count, 1).End(xlUp) would find A5 and .Row would give the row number 5.
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) would find A5 and Offset by 1 row i.e A6 and .Row would give the row number 6.
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row as above gives Row 6 and show + 1 gives Row 7.

So

Sheet2.Cells(Rows.Count, 1).End(xlUp).Row would paste in Row 5 and overwrite the data.
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row would paste in Row 6 so the row below the data.
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row +1 would paste in Row 7 so 2 rows below the data (data-blank row-paste row).

----------------------------------------------------------------------------------------------------------------------------

By the below I don't think that you want a row after each paste. I think that you want a blank row after each change of data. Which is different.

Can you please clarify with a manual example (about 10 rows) using the boards XL2BB addin of how you want Sheet2 to look at the end please

Yes it is blank row after each change of data. Sorry if not making myself clear.

 

[MARK858]

Keep your original code and when it is finished then run the sub below.

Sub InsertBlankRows()

    Dim LastRow As Long
    Dim i As Long

    Application.ScreenUpdating = False
    LastRow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

    For i = LastRow To 2 Step -1
        If Sheets("Sheet2").Cells(i, "A") <> Sheets("Sheet2").Cells(i - 1, "A") Then Sheets("Sheet2").Rows(i).Insert
    Next i
    
    Application.ScreenUpdating = True
End Sub

 

[Davebro]

Sub InsertBlankRows() Dim LastRow As Long Dim i As Long Application.ScreenUpdating = False LastRow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row For i = LastRow To 2 Step -1 If Sheets("Sheet2").Cells(i, "A") <> Sheets("Sheet2").Cells(i - 1, "A") Then Sheets("Sheet2").Rows(i).Insert Next i Application.ScreenUpdating = True End Sub

I pasted my data in, then ran the macro and it put a space between each row of data

data

data

data

 

[MARK858]

It will only put a blank row in if there is a difference in the cell value from one cell in column A to the cell above it.
If you think otherwise then use the boards XL2BB addin to post a screenshot of your data after you have run your original code (please use the board addin, do not post an image).

 

[Davebro]

It will only put a blank row in if there is a difference in the cell value from one cell in column A to the cell above it.
If you think otherwise then use the boards XL2BB addin to post a screenshot of your data after you have run your original code (please use the board addin, do not post an image).

I do not want to post the personal data I am using, but what happens is I run one of my macro's and it paste the data in

Data
Data
Data
Data
Data

when I run the the insertblankrows macro it transforms the pasted data with a blank row after every row of data

Data

Data

Data

Data

 

[MARK858]

Doesn't for me

123 (1).xlsb
	A
1	qqq
2	qqq
3	aa
4	aa
5	aa
6	aa
7	aaa
8	bb
9	bb
10	bb
11	bb
12	cc
13	cc
14	ddd
15	ddd
16	ddd
17	ddd
Sheet3

becomes

123 (1).xlsb
	A
1	qqq
2	qqq
3
4	aa
5	aa
6	aa
7	aa
8
9	aaa
10
11	bb
12	bb
13	bb
14	bb
15
16	cc
17	cc
18
19	ddd
20	ddd
21	ddd
22	ddd
Sheet2

The only way it would do what you describe is if there is a difference between the cell value from one cell in column A to the cell above it. Only question I will ask is are the cells constants or formulas?

 

[Davebro]

Doesn't for me

123 (1).xlsb
	A
1	qqq
2	qqq
3	aa
4	aa
5	aa
6	aa
7	aaa
8	bb
9	bb
10	bb
11	bb
12	cc
13	cc
14	ddd
15	ddd
16	ddd
17	ddd
Sheet3

becomes

123 (1).xlsb
	A
1	qqq
2	qqq
3
4	aa
5	aa
6	aa
7	aa
8
9	aaa
10
11	bb
12	bb
13	bb
14	bb
15
16	cc
17	cc
18
19	ddd
20	ddd
21	ddd
22	ddd
Sheet2

The only way it would do what you describe is if there is a difference between the cell value from one cell in column A to the cell above it. Only question I will ask is are the cells constants or formulas?

How very strange, the cells are constants. I have tried it with five different macro's.

 

[MARK858]

I am afraid there isn't much I can do for you if you can't supply a desensitised version of your data to test.
Just out of interest (after running your original macro) if in row 3 (I am assuming here that your data starts in row 2) of a blank column you put either the formula =A3=A2 or =EXACT(A3,A2) and drag it down how many TRUE's do you get?

 

[Davebro]

I am afraid there isn't much I can do for you if you can't supply a desensitised version of your data to test.
Just out of interest (after running your original macro) if in row 3 (I am assuming here that your data starts in row 2) of a blank column you put the either the formula =A3=A2 or =EXACT(A3,A2) and drag it down how many TRUE's do you get?

When I run =A3=A2 with my my macro and paste i get all True, when run I the InsertBlankRows I get

FALSE
TRUE
FALSE
TRUE
FALSE
TRUE
FALSE

 

[MARK858]

Strange result for the first test with the results that you are getting but I am afraid that I am at a dead end now without seeing any data.

You can try the code below but I am expecting the same result.

Sub InsertRows1()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    With Sheets("Sheet2").Range("A1", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
       
        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
       
        .Offset(, -1).EntireColumn.Delete
       
        .EntireColumn.RemoveSubtotal
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub