Row Insert Macro not completing entire worksheet

0
votes

I have the following macro to read lines on Sheet1 and insert that number of lines and copy the data on Sheet2. It works fine for only 1 iteration. 

Sub InsertRow()

Dim ws2 As Worksheet
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer

Set sh = Sheet1
Set ws2 = Sheet2

RowCount = 0
For Each rw In sh.Rows
    If sh.Cells(rw.Row, 1).Value = "" Then
        Exit For
    Else
        ws2.Rows(rw.Row).Copy
        ws2.Rows(rw.Row + 1).Insert Shift:=xlDown
    End If

RowCount = RowCount + 1

Next rw

ws2.Rows(1).Delete
MsgBox ("Done")

End Sub

I need help figuring out how to tell it keep going and not finish until it comes across two consecutive blank cells. The worksheet will always be separated by one blank row and then data until the end of the sheet. Right now I have removed the header because it always starts there and I get a bunch of duplicate header rows instead of data rows. Is there a way to tell it to start inserting at row 2 and then keep iterating until 2 consecutive blank rows? The delete needs to be at the end of each iteration because the insert will always be X and since one row already exists on Sheet2 I will always need X-1.

An example worksheet for Sheet1 is this, for each line that exists on Sheet2 it will insert a row and copy the data already in that row on sheet1. When all teh rows are inserted, I will then move Columns B, C, and D over to Sheet2 and delete Sheet1

ColA    ColB    ColC       ColD
Srvr    9          12      Data
Srvr2   7          22      Data
Srvr9   15         14      Data
Blank row    
Srvr3   17         18      Data
Srvr19  18         27      Data
blank row
2
excelvba
where are you setting the Range for rw ? – Shai Rado
and don't you mean Set sh = Sheets("Sheet1") and Set ws2 = Sheets("Sheet2") ? – Shai Rado
I m slightly confused. Can you show us a sample data? – Siddharth Rout
I'm truly sorry, but I still don't follow what you are looking for. Where in sheet one do you want to copy rows from sheet 2? What are you trying to delete when you say "The delete needs to be at the end of each iteration"? Is the example that you gave what sheet one is or what sheet one should look like? – PartyHatPanda
I am not copying anything from Sheet1 in this code, All I want to do is basically get a count of how many lines come before the blank. Then in Row 1 of Sheet2 I am inserting that count minus one (since row1 already exists on sheet2) then the next count before a blank should insert in what used to be row2 on Sheet2 but is now further down aftter the last insertion. So for example the count on sheet1 is 11, so on Sheet2, I now insert 11 rows below row1 but delete 1 because I have 12 and need 11. Then now the original row2 is now row 12, so this needs to be the start of the next insertion – Nolemonkey

2 Answers

1
votes

A quick modification should continue the code until two blank rows:

Change If sh.Cells(rw.Row, 1).Value = "" Then to If sh.Cells(rw.Row, 1).Value = "" And sh.Cells(rw.Row+1, 1).Value = "" Then

I am not sure what you are asking at the end of your question though about starting to insert at row 2 and x-1, etc.

1
votes

I ended up going with the following to accomplish the task. @PartyHatPanda thanks for helping me find 2 empty rows back to back. I incorporated that into my final code. I added an ElseIf and that did the trick. To deal with the blank rows, I left them in there that way the rows line up with the copy and paste, then I wrote a delete sub to get rid of the blank rows. 

Sub InsertRow()

Dim ws2 As Worksheet
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer

Set sh = Sheet1
Set ws2 = Sheet2

RowCount = 0
For Each rw In sh.Rows
    If sh.Cells(rw.Row, 1).Value = "" And sh.Cells(rw.Row + 1, 1).Value = "" Then
        Exit For
    ElseIf sh.Cells(rw.Row, 1).Value = "" Then
        ws2.Rows(rw.Row).ClearContents
    Else
        ws2.Rows(rw.Row).Copy
        ws2.Rows(rw.Row + 1).Insert Shift:=xlDown
    End If

'RowCount = RowCount

Next rw

MsgBox ("Done")

End Sub