Finding the second empty row

[Cloud67]

Hi,

I have a code to copy and paste values till first empty row but then I want vba to copy and paste values after that till it find second empty row. So For first I did

 Lastrow = Cells.Find(What:="*", After:=[A20], SearchOrder:=xlByRows).Row
Range("A1:H" & Lastrow - 1).Offset(19, 0).Copy
ws2.Activate
Range("A22").Insert Shift:=xlDown

and for the second I did

Nextrow = 21 + Lastrow
Lastrow2 = Cells.Find(What:="*", After:=ws1.Cells(Nextrow, 1), SearchOrder:=xlByRows).Row
Range("A1:H" & Lastrow2 - 1).Offset(Nextrow, 0).Copy
ws2.Activate
Range("A" & Nextrow).Insert Shift:=xlDown

For first one it works but for second one it is not finding the empty row after and instead putting the "Lastrow2" value same as "Nextrow". Can someone help me with that. Thanks

 

[Cloud67]

Hi Dante,
Trust me, I didn't doubt your intentions even for a sec . I was just trying to explain it to you. So when I tried your code with your file, it copy the five rows of table 1, which is fine because table one has five rows but then it again copy five rows for table 2 too, though table 2 is 16 rows long.

Thanks a lot for your help.

 

[Cloud67]

sss

 

[DanteAmor]

I had an error in the sequence of steps

Try this macro in my file

Sub copy_data()
    'Finding the second empty row
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim r As Range, a As Range, [B][COLOR=#0000ff]n [/COLOR][/B]As Long, [B][COLOR=#008000]k[/COLOR][/B] As Long
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    Set r = ws1.Range("A19", ws1.Range("A" & Rows.Count).End(xlUp)(2))
    
    [B][COLOR=#0000FF]n [/COLOR][/B]= r.SpecialCells(xlCellTypeConstants).Areas(1).Rows.Count
    r.SpecialCells(xlCellTypeConstants).Areas(1).Resize([B][COLOR=#0000FF]n [/COLOR][/B], 8).Copy  'copy first table
    ws2.Range("A22").Insert Shift:=xlDown
    
    [B][COLOR=#008000]k[/COLOR][/B]= r.SpecialCells(xlCellTypeConstants).Areas(2).Rows.Count
    r.SpecialCells(xlCellTypeConstants).Areas(2).Resize([B][COLOR=#008000]k[/COLOR][/B], 8).Copy  'copy second table
    
    ws2.Range("A" & 22 + [B][COLOR=#0000FF]n [/COLOR][/B]+ 1).Insert Shift:=xlDown
End Sub

 

[Cloud67]

Awesome, you are the best. Just for my knowledge, "SpecialCells(xlCellTypeConstants).Areas(1)" does this thing defines the area before the empty row and when you put "Area(2)" it defines the area after Area (1) till the next empty row?

 

[DanteAmor]

Awesome, you are the best. Just for my knowledge, "SpecialCells(xlCellTypeConstants).Areas(1)" does this thing defines the area before the empty row and when you put "Area(2)" it defines the area after Area (1) till the next empty row?

That's right!

 

[Cloud67]

Hi Dante,

Sorry to bother you again but I have one more question. Sometimes i have third Area so How I could check if I have Area(3) and If it is there then copy and paste it the same way.

Thanks

 

[DanteAmor]

Hi Dante,

Sorry to bother you again but I have one more question. Sometimes i have third Area so How I could check if I have Area(3) and If it is there then copy and paste it the same way.

Thanks

Try this

Sub copy_data()
    'Finding the second empty row
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim r As Range, n As Long, k As Long, cuantas As Long, f As Long, i As Long
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    Set r = ws1.Range("A19", ws1.Range("A" & Rows.Count).End(xlUp)(2))
    
    cuantas = r.SpecialCells(xlCellTypeConstants).Areas.Count
    If cuantas >= 3 Then cuantas = 3
    f = 22
    For i = 1 To cuantas
        n = r.SpecialCells(xlCellTypeConstants).Areas(i).Rows.Count
        r.SpecialCells(xlCellTypeConstants).Areas(i).Resize(n, 8).Copy   'copy  table
        ws2.Range("A" & f).Insert Shift:=xlDown
        f = f + n + 1
    Next
End Sub