VBA Code to Copy Non Blank Cells From one Sheet to Another - vba

Question

I'm trying to write a VBA code to copy "Non-Blank" cells from one file to another. This code selects the last Non Blank row, but for the column it's copying A4 to AU. I'd like to copy columns A4 to LastcolumnNotblank and also last row. So basically copy A4 to (LastColumn)(LastRow)Not Blank
Would be really grateful if someone can help by editing the below code. Many thanks.
Sub Export_Template()
'' TPD
File_name = Application.GetSaveAsFilename(InitialFileName:="Engineering TPD", FileFilter:="Excel Files (*.xlsx), *.xlsx")
If File_name <> False Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To LastRow
If Left(ActiveSheet.Range("A" & i).Value, 1) <> "" Then lastactiverow = i
Next i
'MsgBox (lastactiverow)
ActiveSheet.Range("A4:AU" & lastactiverow).Select
Selection.Copy
Set NewBook = Workbooks.Add
ActiveSheet.Range("A1").PasteSpecial xlPasteValues
ActiveWorkbook.SaveAs Filename:=File_name, FileFormat:=51
ActiveWorkbook.Close (False)
End If
End Sub

Answer 1

The code below will preserve your ActiveSheet range and use SaveAs to save to a new workbook with your specific name, without all the extra crap. It deletes all the sheets except for the ActivSheet, and deletes the first three rows, then using SaveAs to save to ThisWorkbook.Path. Your macro enabled workbook will not be changed.
I actually don't like to use ActiveSheet due to the obvious problems, but since you were using it i kept it. I would suggest you use the name of the worksheet.
Sub SaveActiveSheetRangeAsNewWorkbook()
Dim ws As Worksheet
Application.DisplayAlerts = False
With ThisWorkbook
For Each ws In Application.ThisWorkbook.Worksheets
If ws.Name <> ActiveSheet.Name Then
ws.Delete
End If
Next
.Sheets(1).Range("A1:A3").EntireRow.Delete
.SaveAs Filename:="Engineering TPD", FileFormat:=xlOpenXMLWorkbook
End With
Application.DisplayAlerts = True
End Sub

Answer 2

I'm assuming that Col A is a good indicator of where to find your last used row
Also assuming that Row 1 is a good indicator of where to find your last used column
You need to change Sheet1 on 3rd line of code to the name of your sheet that has the data to be copied
You need to declare variables (Use Option Explicit)
Avoid .Select and .Selection at all costs (none are found in below solution)
You did not re-enable ScreenUpdating and DisplayAlerts
This is tested and works A-OK
Option Explicit
Sub Export_Template()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim NewBook As Workbook
Dim LRow As Long, LCol As Long
Dim FileName
FileName = Application.GetSaveAsFilename(InitialFileName:="Engineering TPD", FileFilter:="Excel Files (*.xlsx), *.xlsx")
If FileName <> False Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set NewBook = Workbooks.Add
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
LCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
ws.Range(ws.Cells(4, 1), ws.Cells(LRow, LCol)).Copy
NewBook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
NewBook.SaveAs FileName:=FileName, FileFormat:=51
NewBook.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub