Can anyone tell me why macro wont work in office 2015/6 but works perfectly in office 2010, any help would be gladly appreciated, all that happens is I get the following error message.
An error has occurred. Please ensure you are selecting the NROL spreadsheet and that the data is in a sheet named "Sheet1". The macro will now close.
Below is the Macro/VBA, by the way I am only a novice and Thanks in advance
Sub CreateWorkplan()
'Turn off screen updating and alerts. Deal with errors
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo errorhandler:
'Save this workbook name for later use.
Dim this_workbook As String
this_wb = ActiveWorkbook.Name
'Allow user to select a workbook and then open it and save its name
Var = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=False)
Workbooks.Open (Var)
Dim from_wb As String
from_wb = ActiveWorkbook.Name
'create a new workbook which will be the output one
Dim workingbook As String
Workbooks.Add
workingbook = ActiveWorkbook.Name
Sheets("Sheet1").Delete
'copy the regions sheet from this WB to the output, copy the sheet 1 from the user selected WB to this one
Workbooks(this_wb).Sheets("Regions").Copy Before:=Workbooks(workingbook).Sheets(1)
Workbooks(workingbook).Sheets("Regions").Visible = False
Workbooks(from_wb).Sheets("Sheet1").Copy Before:=Workbooks(workingbook).Sheets(1)
Workbooks(workingbook).Activate
'Delete the extra sheets
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Dim lr_dupe As Long
lr_dupe = ActiveSheet.UsedRange.Rows.Count
Range(Cells(4, 1), Cells(lr_dupe, 52)).RemoveDuplicates Columns:=3, Header:=xlNo
Call rearrange_columns
Sheets("Sheet1").Delete
Sheets("Workplan").Name = "Sheet1"
'insert an extra first column before col A, copy the week numbers to this column and then delete the duplicates
Sheets("Sheet1").Activate
Range("A1").EntireColumn.Insert
Range("B:B").Copy Destination:=Range("A:A")
Sheets("Sheet1").Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
'find out how many unique weeks there are
LastrowA = Range("A100").End(xlUp).Row
ar_sz = LastrowA - 4
'create an array with the week numbers in it.
Dim trg_shts() As String
ReDim trg_shts(ar_sz)
'ar_sz = Nothing
On Error Resume Next
'for each of the unique weeks in column A, create a sheet with that name
For i = 4 To LastrowA
sht_name = Trim(Sheets("Sheet1").Cells(i, 1).Value)
sht_name = "Week " & sht_name
trg_shts(i - 4) = sht_name
Sheets(sht_name).Delete
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sht_name
Next i
On Error GoTo errorhandler
'delete the column with the week numbers in
Sheets("Sheet1").Range("A1").EntireColumn.Delete
Sheets("Sheet1").Activate
Dim dest_sht As String
'find the last row in the NROL sheet.
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim arr2() As Variant
Dim machine_number As Long
num_machines = Sheets("Regions").Range("A1000").End(xlUp).Row
Sheets("Regions").Visible = True
Sheets("Regions").Activate
Set rng1 = Sheets("Regions").Range(Cells(1, 1), Cells(num_machines, 1))
arr2 = Application.Transpose(rng1.Value)
Sheets("Regions").Visible = False
Sheets("Sheet1").Activate
'Stop
'for every row loop through and find the week number. This is in column 2 for every row. Assign this to 'dest_sht
'copy the entire row to dest_sht
For i = 4 To LastRow
dest_sht = Cells(i, 1).Value
On Error Resume Next
machine_number = Cells(i, 2).Value
On Error Resume Next
test_true = Application.Match(machine_number, arr2, 0)
On Error GoTo errorhandler
On Error GoTo 0
If IsError(test_true) = False Or machine_number = 0 Then
Dim can As String
can = Cells(i, 23).Value
If Cells(i, 23).Value = "Cancelled" Then
With Range(Cells(i, 1), Cells(i, 27)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
End If
dest_sht = "Week " & dest_sht
Range(Cells(i, 1), Cells(i, 27)).Copy Destination:=Sheets(dest_sht).Cells(i, 1)
End If
test_true = 0
machine_number = 0
Next i
Dim sel_sht As String
'for each sheet, loop through and do the following calculations
For i = 0 To UBound(trg_shts)
sel_sht = trg_shts(i)
Sheets(sel_sht).Activate
'Delete the blank rows
ActiveSheet.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp
'insert an extra row at the top to be the header row
Range("A1").EntireRow.Insert
Range("B1").Value = "Machine"
Range("C1").Value = "Won No."
Range("D1").Value = "DS Number"
Range("E1").Value = "Work Owner"
Range("F1").Value = "Machine Driver"
Range("G1").Value = "Machine Conductor"
Range("H1").Value = "Additional Opps"
Range("I1").Value = "Poss Details"
Range("J1").Value = "Poss Details"
Range("K1").Value = "Comments"
Range("L1").Value = "Stabled"
Range("M1").Value = "Worksite"
Range("N1").Value = "Stabled"
Range("O1").Value = "Day"
Range("P1").Value = "Start Date & Time"
Range("Q1").Value = "Finish Date & Time"
Range("R1").Value = "Work Description"
Range("S1").Value = "PPS Ref"
Range("T1").Value = "Access"
Range("U1").Value = "Post Code"
Range("V1").Value = "Grid Ref"
Range("X1").Value = "Stop Signal"
Range("Y1").Value = "Possession Taken Around Train"
Range("Z1").Value = "PDP Signal"
Range("AA1").Value = "Possession Given Up Around Train"
Range("W1").EntireColumn.Delete
'insert a column before A.
Range("A1").EntireColumn.Insert
Range("A1").Value = "Region"
'insert a column after Machine.
Range("D1").EntireColumn.Insert
Range("D1").Value = "Headcode"
'work out how many rows are used in this sheet
LR_temp = Cells(LastRow, 2).End(xlUp).Row
'find how many rows are used in the regions sheet
reg_rows = Sheets("Regions").Range("A1000").End(xlUp).Row
'for every used row in this sheet, make column A have a vlookup formula to work out the region from machine number
Range(Cells(2, 1), Cells(LR_temp, 1)).FormulaR1C1 = "=vlookup(RC3,'Regions'!R1C1:R" & reg_rows & "C2,2, False)"
'paste special a blank cell on the machine number so it goes from text to number type
'without this, the vlookup wont work
Sheets("Sheet1").Range("A1").Clear
Sheets("Sheet1").Range("A1").Copy
Range("C:C").PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd
'for every used row in this sheet, make column D have a vlookup formula to work out the headcode from machine number
Range(Cells(2, 4), Cells(LR_temp, 4)).FormulaR1C1 = "=vlookup(RC3,'Regions'!R1C1:R" & reg_rows & "C3,3, False)"
'Do a filter. Sort by first region then by machine number
Range("A1:AC1").Select
Selection.AutoFilter
ActiveSheet.AutoFilter.Sort.SortFields.Clear
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 1), Cells(LR_temp, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 3), Cells(LR_temp, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 18), Cells(LR_temp, 18)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Call col_widths
Next i
'Rename the base sheet as from NROL
Sheets("Sheet1").Name = "From NROL"
Sheets("From NROL").Visible = False
'close the original NROL workbook
Workbooks(from_wb).Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
'ir an error occurs this message will display
errorhandler:
MsgBox "An error has occurred. Please ensure you are selecting the NROL spreadsheet and that the data is in a sheet named 'Sheet1'. The macro will now close"
'screen updating and alerts back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub rearrange_columns()
Dim LastRow As Long
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "workplan"
LastRow = Worksheets("Sheet1").Cells(50000, 1).End(xlUp).Row
Sheets("Sheet1").Activate
Worksheets("Sheet1").Range(Cells(1, 2), Cells(LastRow, 2)).Copy Destination:=Sheets("workplan").Cells(1, 1)
Worksheets("Sheet1").Range(Cells(1, 17), Cells(LastRow, 17)).Copy Destination:=Sheets("workplan").Cells(1, 2)
Worksheets("Sheet1").Range(Cells(1, 3), Cells(LastRow, 3)).Copy Destination:=Sheets("workplan").Cells(1, 4)
Worksheets("Sheet1").Range(Cells(1, 8), Cells(LastRow, 8)).Copy Destination:=Sheets("workplan").Cells(1, 5)
Worksheets("Sheet1").Range(Cells(1, 50), Cells(LastRow, 51)).Copy Destination:=Sheets("workplan").Cells(1, 9)
Worksheets("Sheet1").Range(Cells(1, 11), Cells(LastRow, 11)).Copy Destination:=Sheets("workplan").Cells(1, 11)
Worksheets("Sheet1").Range(Cells(1, 18), Cells(LastRow, 18)).Copy Destination:=Sheets("workplan").Cells(1, 12)
Worksheets("Sheet1").Range(Cells(1, 10), Cells(LastRow, 10)).Copy Destination:=Sheets("workplan").Cells(1, 13)
Worksheets("Sheet1").Range(Cells(1, 19), Cells(LastRow, 19)).Copy Destination:=Sheets("workplan").Cells(1, 14)
Worksheets("Sheet1").Range(Cells(1, 20), Cells(LastRow, 21)).Copy Destination:=Sheets("workplan").Cells(1, 16)
Worksheets("Sheet1").Range(Cells(1, 28), Cells(LastRow, 28)).Copy Destination:=Sheets("workplan").Cells(1, 18)
Worksheets("Sheet1").Range(Cells(1, 36), Cells(LastRow, 36)).Copy Destination:=Sheets("workplan").Cells(1, 19)
Worksheets("Sheet1").Range(Cells(1, 45), Cells(LastRow, 47)).Copy Destination:=Sheets("workplan").Cells(1, 20)
Worksheets("Sheet1").Range(Cells(1, 4), Cells(LastRow, 4)).Copy Destination:=Sheets("workplan").Cells(1, 23)
Worksheets("Sheet1").Range(Cells(1, 22), Cells(LastRow, 23)).Copy Destination:=Sheets("workplan").Cells(1, 24)
Worksheets("Sheet1").Range(Cells(1, 25), Cells(LastRow, 26)).Copy Destination:=Sheets("workplan").Cells(1, 26)
End Sub
Sub col_widths()
Range("A1").EntireColumn.ColumnWidth = 9
Range("B1").EntireColumn.ColumnWidth = 3
Range("C1").EntireColumn.ColumnWidth = 14
Range("D1:E1").EntireColumn.ColumnWidth = 10
Range("F1").EntireColumn.ColumnWidth = 12
Range("G1").EntireColumn.ColumnWidth = 26
Range("H1:J1").EntireColumn.ColumnWidth = 20
Range("K1:L1").EntireColumn.ColumnWidth = 35
Range("M1").EntireColumn.ColumnWidth = 50
Range("N1:P1").EntireColumn.ColumnWidth = 30
Range("Q1").EntireColumn.ColumnWidth = 8
Range("R1:S1").EntireColumn.ColumnWidth = 21
Range("T1").EntireColumn.ColumnWidth = 26
Range("U1").EntireColumn.ColumnWidth = 18
Range("V1").EntireColumn.ColumnWidth = 26
Range("W1").EntireColumn.ColumnWidth = 10
Range("X1:Y1").EntireColumn.ColumnWidth = 14
Range("Z1").EntireColumn.ColumnWidth = 17
Range("AA1").EntireColumn.ColumnWidth = 14
Range("AB1:AB1").EntireColumn.ColumnWidth = 17
Range("Q2:Q400").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
With Selection.Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Regions!$E$1:$E$28"
End With
Range("A1:AB350").Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.ReadingOrder = xlContext
End With
Columns("K:O").Select
With Selection
.WrapText = True
End With
Rows("1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
End Sub
An error has occurred. Please ensure you are selecting the NROL spreadsheet and that the data is in a sheet named "Sheet1". The macro will now close.
Below is the Macro/VBA, by the way I am only a novice and Thanks in advance
Sub CreateWorkplan()
'Turn off screen updating and alerts. Deal with errors
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo errorhandler:
'Save this workbook name for later use.
Dim this_workbook As String
this_wb = ActiveWorkbook.Name
'Allow user to select a workbook and then open it and save its name
Var = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=False)
Workbooks.Open (Var)
Dim from_wb As String
from_wb = ActiveWorkbook.Name
'create a new workbook which will be the output one
Dim workingbook As String
Workbooks.Add
workingbook = ActiveWorkbook.Name
Sheets("Sheet1").Delete
'copy the regions sheet from this WB to the output, copy the sheet 1 from the user selected WB to this one
Workbooks(this_wb).Sheets("Regions").Copy Before:=Workbooks(workingbook).Sheets(1)
Workbooks(workingbook).Sheets("Regions").Visible = False
Workbooks(from_wb).Sheets("Sheet1").Copy Before:=Workbooks(workingbook).Sheets(1)
Workbooks(workingbook).Activate
'Delete the extra sheets
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Dim lr_dupe As Long
lr_dupe = ActiveSheet.UsedRange.Rows.Count
Range(Cells(4, 1), Cells(lr_dupe, 52)).RemoveDuplicates Columns:=3, Header:=xlNo
Call rearrange_columns
Sheets("Sheet1").Delete
Sheets("Workplan").Name = "Sheet1"
'insert an extra first column before col A, copy the week numbers to this column and then delete the duplicates
Sheets("Sheet1").Activate
Range("A1").EntireColumn.Insert
Range("B:B").Copy Destination:=Range("A:A")
Sheets("Sheet1").Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
'find out how many unique weeks there are
LastrowA = Range("A100").End(xlUp).Row
ar_sz = LastrowA - 4
'create an array with the week numbers in it.
Dim trg_shts() As String
ReDim trg_shts(ar_sz)
'ar_sz = Nothing
On Error Resume Next
'for each of the unique weeks in column A, create a sheet with that name
For i = 4 To LastrowA
sht_name = Trim(Sheets("Sheet1").Cells(i, 1).Value)
sht_name = "Week " & sht_name
trg_shts(i - 4) = sht_name
Sheets(sht_name).Delete
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sht_name
Next i
On Error GoTo errorhandler
'delete the column with the week numbers in
Sheets("Sheet1").Range("A1").EntireColumn.Delete
Sheets("Sheet1").Activate
Dim dest_sht As String
'find the last row in the NROL sheet.
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim arr2() As Variant
Dim machine_number As Long
num_machines = Sheets("Regions").Range("A1000").End(xlUp).Row
Sheets("Regions").Visible = True
Sheets("Regions").Activate
Set rng1 = Sheets("Regions").Range(Cells(1, 1), Cells(num_machines, 1))
arr2 = Application.Transpose(rng1.Value)
Sheets("Regions").Visible = False
Sheets("Sheet1").Activate
'Stop
'for every row loop through and find the week number. This is in column 2 for every row. Assign this to 'dest_sht
'copy the entire row to dest_sht
For i = 4 To LastRow
dest_sht = Cells(i, 1).Value
On Error Resume Next
machine_number = Cells(i, 2).Value
On Error Resume Next
test_true = Application.Match(machine_number, arr2, 0)
On Error GoTo errorhandler
On Error GoTo 0
If IsError(test_true) = False Or machine_number = 0 Then
Dim can As String
can = Cells(i, 23).Value
If Cells(i, 23).Value = "Cancelled" Then
With Range(Cells(i, 1), Cells(i, 27)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
End If
dest_sht = "Week " & dest_sht
Range(Cells(i, 1), Cells(i, 27)).Copy Destination:=Sheets(dest_sht).Cells(i, 1)
End If
test_true = 0
machine_number = 0
Next i
Dim sel_sht As String
'for each sheet, loop through and do the following calculations
For i = 0 To UBound(trg_shts)
sel_sht = trg_shts(i)
Sheets(sel_sht).Activate
'Delete the blank rows
ActiveSheet.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp
'insert an extra row at the top to be the header row
Range("A1").EntireRow.Insert
Range("B1").Value = "Machine"
Range("C1").Value = "Won No."
Range("D1").Value = "DS Number"
Range("E1").Value = "Work Owner"
Range("F1").Value = "Machine Driver"
Range("G1").Value = "Machine Conductor"
Range("H1").Value = "Additional Opps"
Range("I1").Value = "Poss Details"
Range("J1").Value = "Poss Details"
Range("K1").Value = "Comments"
Range("L1").Value = "Stabled"
Range("M1").Value = "Worksite"
Range("N1").Value = "Stabled"
Range("O1").Value = "Day"
Range("P1").Value = "Start Date & Time"
Range("Q1").Value = "Finish Date & Time"
Range("R1").Value = "Work Description"
Range("S1").Value = "PPS Ref"
Range("T1").Value = "Access"
Range("U1").Value = "Post Code"
Range("V1").Value = "Grid Ref"
Range("X1").Value = "Stop Signal"
Range("Y1").Value = "Possession Taken Around Train"
Range("Z1").Value = "PDP Signal"
Range("AA1").Value = "Possession Given Up Around Train"
Range("W1").EntireColumn.Delete
'insert a column before A.
Range("A1").EntireColumn.Insert
Range("A1").Value = "Region"
'insert a column after Machine.
Range("D1").EntireColumn.Insert
Range("D1").Value = "Headcode"
'work out how many rows are used in this sheet
LR_temp = Cells(LastRow, 2).End(xlUp).Row
'find how many rows are used in the regions sheet
reg_rows = Sheets("Regions").Range("A1000").End(xlUp).Row
'for every used row in this sheet, make column A have a vlookup formula to work out the region from machine number
Range(Cells(2, 1), Cells(LR_temp, 1)).FormulaR1C1 = "=vlookup(RC3,'Regions'!R1C1:R" & reg_rows & "C2,2, False)"
'paste special a blank cell on the machine number so it goes from text to number type
'without this, the vlookup wont work
Sheets("Sheet1").Range("A1").Clear
Sheets("Sheet1").Range("A1").Copy
Range("C:C").PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd
'for every used row in this sheet, make column D have a vlookup formula to work out the headcode from machine number
Range(Cells(2, 4), Cells(LR_temp, 4)).FormulaR1C1 = "=vlookup(RC3,'Regions'!R1C1:R" & reg_rows & "C3,3, False)"
'Do a filter. Sort by first region then by machine number
Range("A1:AC1").Select
Selection.AutoFilter
ActiveSheet.AutoFilter.Sort.SortFields.Clear
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 1), Cells(LR_temp, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 3), Cells(LR_temp, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
Cells(2, 18), Cells(LR_temp, 18)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Call col_widths
Next i
'Rename the base sheet as from NROL
Sheets("Sheet1").Name = "From NROL"
Sheets("From NROL").Visible = False
'close the original NROL workbook
Workbooks(from_wb).Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
'ir an error occurs this message will display
errorhandler:
MsgBox "An error has occurred. Please ensure you are selecting the NROL spreadsheet and that the data is in a sheet named 'Sheet1'. The macro will now close"
'screen updating and alerts back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub rearrange_columns()
Dim LastRow As Long
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "workplan"
LastRow = Worksheets("Sheet1").Cells(50000, 1).End(xlUp).Row
Sheets("Sheet1").Activate
Worksheets("Sheet1").Range(Cells(1, 2), Cells(LastRow, 2)).Copy Destination:=Sheets("workplan").Cells(1, 1)
Worksheets("Sheet1").Range(Cells(1, 17), Cells(LastRow, 17)).Copy Destination:=Sheets("workplan").Cells(1, 2)
Worksheets("Sheet1").Range(Cells(1, 3), Cells(LastRow, 3)).Copy Destination:=Sheets("workplan").Cells(1, 4)
Worksheets("Sheet1").Range(Cells(1, 8), Cells(LastRow, 8)).Copy Destination:=Sheets("workplan").Cells(1, 5)
Worksheets("Sheet1").Range(Cells(1, 50), Cells(LastRow, 51)).Copy Destination:=Sheets("workplan").Cells(1, 9)
Worksheets("Sheet1").Range(Cells(1, 11), Cells(LastRow, 11)).Copy Destination:=Sheets("workplan").Cells(1, 11)
Worksheets("Sheet1").Range(Cells(1, 18), Cells(LastRow, 18)).Copy Destination:=Sheets("workplan").Cells(1, 12)
Worksheets("Sheet1").Range(Cells(1, 10), Cells(LastRow, 10)).Copy Destination:=Sheets("workplan").Cells(1, 13)
Worksheets("Sheet1").Range(Cells(1, 19), Cells(LastRow, 19)).Copy Destination:=Sheets("workplan").Cells(1, 14)
Worksheets("Sheet1").Range(Cells(1, 20), Cells(LastRow, 21)).Copy Destination:=Sheets("workplan").Cells(1, 16)
Worksheets("Sheet1").Range(Cells(1, 28), Cells(LastRow, 28)).Copy Destination:=Sheets("workplan").Cells(1, 18)
Worksheets("Sheet1").Range(Cells(1, 36), Cells(LastRow, 36)).Copy Destination:=Sheets("workplan").Cells(1, 19)
Worksheets("Sheet1").Range(Cells(1, 45), Cells(LastRow, 47)).Copy Destination:=Sheets("workplan").Cells(1, 20)
Worksheets("Sheet1").Range(Cells(1, 4), Cells(LastRow, 4)).Copy Destination:=Sheets("workplan").Cells(1, 23)
Worksheets("Sheet1").Range(Cells(1, 22), Cells(LastRow, 23)).Copy Destination:=Sheets("workplan").Cells(1, 24)
Worksheets("Sheet1").Range(Cells(1, 25), Cells(LastRow, 26)).Copy Destination:=Sheets("workplan").Cells(1, 26)
End Sub
Sub col_widths()
Range("A1").EntireColumn.ColumnWidth = 9
Range("B1").EntireColumn.ColumnWidth = 3
Range("C1").EntireColumn.ColumnWidth = 14
Range("D1:E1").EntireColumn.ColumnWidth = 10
Range("F1").EntireColumn.ColumnWidth = 12
Range("G1").EntireColumn.ColumnWidth = 26
Range("H1:J1").EntireColumn.ColumnWidth = 20
Range("K1:L1").EntireColumn.ColumnWidth = 35
Range("M1").EntireColumn.ColumnWidth = 50
Range("N1:P1").EntireColumn.ColumnWidth = 30
Range("Q1").EntireColumn.ColumnWidth = 8
Range("R1:S1").EntireColumn.ColumnWidth = 21
Range("T1").EntireColumn.ColumnWidth = 26
Range("U1").EntireColumn.ColumnWidth = 18
Range("V1").EntireColumn.ColumnWidth = 26
Range("W1").EntireColumn.ColumnWidth = 10
Range("X1:Y1").EntireColumn.ColumnWidth = 14
Range("Z1").EntireColumn.ColumnWidth = 17
Range("AA1").EntireColumn.ColumnWidth = 14
Range("AB1:AB1").EntireColumn.ColumnWidth = 17
Range("Q2:Q400").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
With Selection.Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Regions!$E$1:$E$28"
End With
Range("A1:AB350").Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.ReadingOrder = xlContext
End With
Columns("K:O").Select
With Selection
.WrapText = True
End With
Rows("1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
End Sub
