SteveABC
03-19-2021, 03:10 AM
Hello,
Can anyone tell me why the code below only copies columns upto column BR. I have data in column BS & BT but this gets excluded when the data pastes into my new file.
I was under the impression this code would select the range where columns are populated.
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
Sub Pmtemplate()
Dim w As Worksheet, b As Workbook, ol As Object, msg As Object
Dim mypath As String, myfile As String, scc As String, sto As String
mypath = "W:\.Team Documents\Freehold Team\E&J Estates\Reporting\Reports\"
With Sheets("Control")
sto = Join(WorksheetFunction.Transpose(Range("Mail_to")), ";")
scc = Join(WorksheetFunction.Transpose(Range("Mail_cc")), ";")
End With
Set w = Sheets("E&J Master")
Set b = Workbooks.Add
With w
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, 1).Resize(lr, lc).Copy b.Sheets(1).Range("a1")
End With
b.Sheets(1).Cells(4, 1).Resize(lr - 4, lc).Value = b.Sheets(1).Cells(4, 1).Resize(lr - 4, lc).Value2
b.Sheets(1).Name = "E&J PM Master"
ActiveWindow.Zoom = 75
myfile = mypath & Format(Date, "MMM") & " PM Template.xlsx"
'Application.DisplayAlerts = False
'For sh = b.Sheets.Count To 2 Step -1
'b.Sheets(sh).Delete
'Next
'Application.DisplayAlerts = True
b.SaveAs myfile
End Sub
Can anyone tell me why the code below only copies columns upto column BR. I have data in column BS & BT but this gets excluded when the data pastes into my new file.
I was under the impression this code would select the range where columns are populated.
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
Sub Pmtemplate()
Dim w As Worksheet, b As Workbook, ol As Object, msg As Object
Dim mypath As String, myfile As String, scc As String, sto As String
mypath = "W:\.Team Documents\Freehold Team\E&J Estates\Reporting\Reports\"
With Sheets("Control")
sto = Join(WorksheetFunction.Transpose(Range("Mail_to")), ";")
scc = Join(WorksheetFunction.Transpose(Range("Mail_cc")), ";")
End With
Set w = Sheets("E&J Master")
Set b = Workbooks.Add
With w
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, 1).Resize(lr, lc).Copy b.Sheets(1).Range("a1")
End With
b.Sheets(1).Cells(4, 1).Resize(lr - 4, lc).Value = b.Sheets(1).Cells(4, 1).Resize(lr - 4, lc).Value2
b.Sheets(1).Name = "E&J PM Master"
ActiveWindow.Zoom = 75
myfile = mypath & Format(Date, "MMM") & " PM Template.xlsx"
'Application.DisplayAlerts = False
'For sh = b.Sheets.Count To 2 Step -1
'b.Sheets(sh).Delete
'Next
'Application.DisplayAlerts = True
b.SaveAs myfile
End Sub