VBA issue copying data to the same sheet

[Diagoro]

Hi all,

I am fairly new to VBA code so please excuse any mistakes I am making here.

My goal is to find a string (in this example TestStart) and copy everything between that and a second string (TestEnd). These strings are repeatable in the data, so I would like to copy each section between these two strings to a new sheet.

I had been able to find various examples of code online that I have used and this allows me to successfully copy the data between the first TestStart and first TestEnd to a new sheet (called NewSheet in this example). When the code then tries to copy over the data between the second time TestStart and TestEnd are found, it tries to create the another sheet called NewSheet. Which obviously exists.

Can anyone advise how I can copy the repeatable data to the same sheet?

Data Example -

TestStart

AAA

BBB

TestEnd

CCC

TestStart

DDD

EEE

FFF

TestEnd

So from the data above, I would want to have everything copied over to NewSheet apart from CCC.

Code Example -

Sub CopyTEST()

Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets(1).Range("A65536").End(xlUp).Row
With ActiveWorkbook.Worksheets(1).Range("a1:a" & lastrow)

For rownum = 1 To lastrow
Do
If .Cells(rownum, 1).Value = "TestStart" Then
startrow = rownum
End If

rownum = rownum + 1


If (rownum > lastrow) Then Exit For

Loop Until .Cells(rownum, 1).Value = "TestEnd"
endrow = rownum
rownum = rownum + 1

Worksheets(1).Range(startrow & ":" & endrow).copy


Sheets.Add(After:=Sheets("TestSheet")).Name = "NewSheet"
Sheets("NewSheet").Select
Range("A1").Select
ActiveSheet.Paste


Next rownum
End With
End Sub


Regards,
Gavin

 

[RobP]

Hi, you would need to check the Sheet actually exists in the first place, and if not, only then create it. This Private Function will allow that operation, so paste this at the end of your other code (will be a separate function).

Private Function SheetExists(Tabname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(Tabname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

Then in your code, you would check to see if the sheet exists first like thus:

If Not SheetExists("NewSheet") Then
      Sheets.Add(After:=Sheets("TestSheet")).Name = "NewSheet"
Endif
Sheets("NewSheet").Select
'check for last row if you want data to be contiguous
NewSheet_Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row '1 denotes look in col. 1 (A) for last row of data..
Range("A" & NewSheet_Lastrow).Select
ActiveSheet.Paste

The other thing you will then need to do before pasting to Cell "A1" on NewSheet, is I am guessing check the last row of data (if you want it to be contiguous) in order to paste the second / third / fourth lot in the next available cell. (which I added above for you)

See how you get on with that.
cheers
Rob

 

[Diagoro]

Thanks very much for your detailed reply, Rob. It is greatly appreciated.

I am back in the office on Thursday, so will test then and let you know how I get on.

Cheers,
Gavin

 

[RobP]

You're Welcome..

Rob

 

[Diagoro]

Hi Rob,

I updated my code this morning with your suggestions, and the code is doing exactly what I needed.

Thank you so much for taking the time to reply to me.

Regards,
Gavin