fluffynicesheep
Board Regular
- Joined
- Oct 27, 2009
- Messages
- 69
Hi,
I currently have a spreadsheet that contains a tab that I want to copy and paste into a new document. It'll then save, close and exit both documents.
The VBA below works fine at the moment, and does as I need .... apart from one thing ... the new spreadsheet goes up to column WQW, and therefore makes scrolling through it a bit of a nightmare!!
The report tab that it gets the data from will always go up to column EN only, and that's where I'd like the new document to finish. The number of rows could well change each time .... so basically I need my range to be all used rows up to column EN ... and that's what I need to go into the new spreadsheet.
If you can let me know the line that needs changing from below that'll be great!
I currently have a spreadsheet that contains a tab that I want to copy and paste into a new document. It'll then save, close and exit both documents.
The VBA below works fine at the moment, and does as I need .... apart from one thing ... the new spreadsheet goes up to column WQW, and therefore makes scrolling through it a bit of a nightmare!!
The report tab that it gets the data from will always go up to column EN only, and that's where I'd like the new document to finish. The number of rows could well change each time .... so basically I need my range to be all used rows up to column EN ... and that's what I need to go into the new spreadsheet.
If you can let me know the line that needs changing from below that'll be great!
VBA Code:
Sub Save_and_Close()
Dim wbA As Workbook
Dim wbB As Workbook
Dim FName As String
Sheets("Report").Select
Range("EM1").Value = Date
Range("EN1").Value = "Error Report -"
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = False
Set wbA = ThisWorkbook
wbA.Sheets("Report").Visible = True
wbA.Sheets("Report").Copy
Set wbB = ActiveWorkbook
With wbB
With .Sheets(1).UsedRange
.Copy
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
Dim nm As Name
Dim DeleteCount As Long
'Loop through each name and delete
For Each nm In ActiveWorkbook.Names
If InStr(1, nm.RefersTo, "#REF!") Then nm.Delete
On Error GoTo 0
DeleteCount = DeleteCount + 1
Skip:
Next
'Reset Error Handler
On Error GoTo 0
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
FName = "Y:\National Careers Service - Mail Merge\E-Mail Attachments\Error Reports\Error Report - " & _
Format(Range("EE2"), "dd-mm-yyyy") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close SaveChanges:=False
End With
Application.ScreenUpdating = False
Sheets("Report").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Cells(1, 1).Activate
Sheets("Dashboard").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Cells(1, 1).Activate
ActiveCell.Next.Select
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit
End Sub