VBA to copy and paste VALUES of cells into brand new, unsaved workbook

[bakarken]

Hi

I've got a sheet in my workbook called 'CSV' which contains loads of formulas to various other sheets. This data runs through columns A to E, but the final row number of the data could end anywhere between row 1 to row 651. The word 'END' appears on the row AFTER the row with relevant data included, in column A.

E.g. Formulas could result in data running from A1:E55, and the word 'END' will appear in A56.

Is there a VBA that I can use to copy ONLY the information ABOVE 'END' (i.e. copy A1:E55 in my example) into a BRAND NEW workbook, pasting the VALUES? (i.e. the formulas will break or link to the original workbook, but I just want the values generated).

The new workbook can be manually saved by the user afterwards.

Is there anyone who can help?

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWB As Workbook
    Set srcWS = ThisWorkbook.Sheets("CSV")
    Dim LastRow As Long
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    srcWS.Range("A1:E" & LastRow - 1).Copy
    Set desWB = Workbooks.Add
    ActiveWorkbook.Sheets("Sheet1").Cells(1, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[bakarken]

Hi mumps

Thanks so much for the reply that almost does what I want!

Unfortunately there are a few problems:
1. The word 'END' is being included in the new sheet, and I was hoping that everything above (but not including) the end would be copied only
2. In the new sheet, when I press CTRL+END, the final row is 651. I was hoping that (e.g.) 55 would be the final row as my other software will not understand the blank cells
3. Small detail, but column D in the original workbook is full of dates in format DD/MM/YYYY. The new workbook turns this format into a general format e.g. '43100', is there a way that the date formatting in D can be transferred accross?

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWB As Workbook
    Set srcWS = ThisWorkbook.Sheets("CSV")
    Dim lastrow As Long, LastRow2 As Long
    lastrow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastRow2 = srcWS.Range("A1:A" & lastrow - 1).Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    srcWS.Range("A1:E" & LastRow2).Copy
    Set desWB = Workbooks.Add
    ActiveWorkbook.Sheets("Sheet1").Cells(1, 1).PasteSpecial xlPasteValues
    ActiveWorkbook.Sheets("Sheet1").Columns("D").NumberFormat = "dd/mm/yyy"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[bakarken]

Hi Mumps thats soooo nearly perfect!

You have fixed the issues 2) and 3) above, but 1) still exists. The new sheet generated still contains the 'END' row?

 

[mumps]

Try replacing this line of code:

srcWS.Range("A1:E" & LastRow2).Copy

with this line:

srcWS.Range("A1:E" & LastRow2 - 1).Copy

 

[bakarken]

Thats perfect thank you so much!!!!!

 

[mumps]

You are very welcome.