inserting a formula into a cell

marleyps

New Member
Joined
Aug 29, 2003
Messages
38
Hi
I have a worksheet that has a list of names in column A and related numerical data in columns b,c,d etc relating to the named person.
I am writing a macro that creates a new sheet for every name in sheet 1 , formats the sheet and in certain cells looks at the infomation in sheet 1 and puts it in a cell in the persons new sheet. I do not want to copy the data into the new cell as a value, just have a formula that
look up the value in the cell on sheet 1. i have tried this formula but it does not work

Range("D10").formula ="=Worksheets(1).range("g4")"
I am referencing the first sheet by its position as the first sheet ( worksheets(1) )

the error i get when running the macro is that g4 is highlighted and "expected: end of statement" is shown.
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

repairman615

Well-known Member
Joined
Dec 21, 2009
Messages
1,885
Hello,

I may have misunderstood but here is a line:

<font face=Courier New>Range("D10").Formula = "=" & Worksheets(1).Name & "!" & "G4"<br></FONT>

Does that work as expected?
 

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
take the speech marks off g4
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
take the speech marks off g4
? :confused:



Hello,

I may have misunderstood but here is a line:

<font face=Courier New>Range("D10").Formula = "=" & Worksheets(1).Name & "!" & "G4"<br></FONT>

Does that work as expected?
If the name of Sheet(1) contains any spaces, that formula will fail. To allow for that, I would include ' ' around the name as follows. Also, the string doesn't need to be broken up that much.
Rich (BB code):
Range("D10").Formula = "='" & Worksheets(1).Name & "'!G4"
 
Last edited:

marleyps

New Member
Joined
Aug 29, 2003
Messages
38

ADVERTISEMENT

thanks for your help and quick response mole 999 and repairman615 . repairman615 your first solution did not work but the second one worked fine. I forgot one thing though as the macro progresses and creates new sheets for each name the data that has to be referenced moves down one row for each name. eg with the data below

name data in g4

Bob 56
jim 45
paul 22

after creating a new sheet for bob and putting 56 in cell d10, when the macro creates the sheet for jim i need to get the data from sheet 1 g5 to put into cell d10 in the jim sheet
maybeI need to do a vlookup formula where, when the new sheet is created and named the macro has to go to sheet1 and match the new sheet name with the name in col 1 then extract the date in the relevent column of the selected row. your thoughts would be appreciated
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
repairman615 your first solution did not work but the second one worked fine.
Hmm, I'm having trouble determining which two of repairman's solutions you are referring to. :eek:



I forgot one thing though as the macro progresses and creates new sheets for each name the data that has to be referenced moves down one row for each name. eg with the data below

name data in g4

Bob 56
jim 45
paul 22

after creating a new sheet for bob and putting 56 in cell d10, when the macro creates the sheet for jim i need to get the data from sheet 1 g5 to put into cell d10 in the jim sheet
Do you have some sort of loop to create the sheets? If so, could we see it?

If not, what code structure are you using to create the list of sheets? Could we see it?
 

marleyps

New Member
Joined
Aug 29, 2003
Messages
38

ADVERTISEMENT

hi
I am posting the complete code that i am using to create the new sheets
most of it i picked up from the web.



Sub Copy_Every_Sheet_To_New_Workbook()
'Working in 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
MkDir FolderName

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

'If the sheet is visible then copy it to a new workbook
If sh.Visible = -1 Then
sh.Copy

'Set Destwb to the new workbook
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
If Sourcewb.Name = .Name Then
MsgBox "Your answer is NO in the security dialog"
GoTo GoToNextSheet
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

'Change all cells in the worksheet to values if you want
'If Destwb.Sheets(1).ProtectContents = False Then
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
'End If


'Save the new workbook and close it
With Destwb


Dim person As Range, namerange As Range 'create two variables of type range
Application.DisplayAlerts = False 'deletes on sreen warning messages


Set person = Sheets(1).Range("A4") 'sets the number of rows with peoples names in them as a range`
Set namerange = Range(person, person.End(xlDown))

For Each person In namerange 'start of loop that creates new worksheets
Sheets.Add AFTER:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = person.Value ' renames the new worksheet

Range("A1:C2").Select 'THIS SECTION MERGES A1 TO C2
With Selection
.MergeCells = True
End With

ActiveSheet.[A1] = "SCHOOL NAME" 'Names cell A1

Range("D1:F2").Select 'merges cell range
With Selection
.MergeCells = True
End With





ActiveSheet.[a3] = "EMPLOYEE NAME" 'names cell A3
Range("A3:C3").Select 'merges cell range
With Selection
.MergeCells = True
End With


Range("A7:K7").Select 'THIS SECTION MERGES RANGE
With Selection
.MergeCells = True
End With


ActiveSheet.[D3] = person.Value 'puts Name in cell A1
Range("D3:F3").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[A4] = "NI NUMBER" 'names cell A4
Range("A4:C4").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("D4:F4").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a5] = "PAYROLL NUMBER" 'names cell A5
Range("A5:C5").Select 'merges cell range
With Selection
.MergeCells = True
End With


Range("D5:F5").Select 'merges cell range
With Selection
.MergeCells = True
End With


ActiveSheet.[a6] = "JOB TITLE" 'names cell A6
Range("A6:C6").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("D6:F6").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[G1] = "SCHOOL CODE" 'names cell G1
Range("G1:G2").Select 'merges cell range and wraps text
With Selection
.MergeCells = True
.WrapText = True
End With

Range("H1:I2").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[J1] = "YEAR" 'names cell J1
Range("J1:J2").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("K1:K2").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[K3] = "DATE" 'names cell K3

ActiveSheet.[g4] = "COMPLETED BY" 'names cell G4
Range("G4:H4").Select 'merges cell range
With Selection
.MergeCells = True
End With


Range("I4:J4").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[G5] = "CHECKED BY" 'names cell G5
Range("G5:H5").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("I5:J5").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("G6:K6").Select 'blacks out range cells
With Selection.Interior
.ColorIndex = 1
End With

Range("G3:J3").Select 'blacks out range cells
With Selection.Interior
.ColorIndex = 1
End With

ActiveSheet.[A8] = "MONTH" 'names cell A8
Range("A8:B9").Select 'merges cell range
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[C8] = "CONS (£)" 'names cell C8
Range("C8:C9").Select 'merges cell range
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[D8] = "PENSION. PAY" 'names cell D8
Range("D8:D9").Select 'merges cell PAY and wraps text
With Selection
.MergeCells = True
.WrapText = True 'THIS SECTION MERGES A1 TO C2
End With

ActiveSheet.[E8] = "SPINAL POINT" 'names cell E8
Range("E8:E9").Select 'THIS SECTION MERGES SPINAL POINT
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[G8] = "HOURS" 'names cell G8
Range("G8:H8").Select 'THIS SECTION MERGES HOURS
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[F8] = "F/T SALARY" 'names cell F8
Range("F8:F9").Select
With Selection
.MergeCells = True 'THIS SECTION MERGES F/T SALARY
.WrapText = True
End With


ActiveSheet.[G9] = "WORKED" 'names cell G9
ActiveSheet.[H9] = "PAID" 'names cell H9
ActiveSheet.[I8] = "WEEKS PAID" 'names cell I8
Range("I8:I9").Select 'THIS SECTION MERGES WEEKS PAID
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[J8] = "TOTAL WEEKS" 'names cell J8
Range("J8:J9").Select 'THIS SECTION MERGES TOTAL WEEKS
With Selection
.MergeCells = True
.WrapText = True
End With

ActiveSheet.[K8] = "NOTES" 'names cell K8
Range("K8:K9").Select
With Selection
.MergeCells = True 'THIS SECTION MERGES Notes
.WrapText = True
End With

ActiveSheet.[a23] = "COMMENTS" 'names cell A23
Range("A23:K23").Select 'THIS SECTION MERGES COMMENTS
With Selection
.MergeCells = True
End With

Range("A24:K34").Select 'THIS SECTION MERGES A1 TO C2
With Selection
.MergeCells = True
End With

ActiveSheet.[A35] = "CALCULATIONS" 'names cell A35
Range("A35:K35").Select 'THIS SECTION MERGES A1 TO C2
With Selection
.MergeCells = True

ActiveSheet.[a10] = "April" 'names cell A10
Range("A10:B10").Select 'merges cell range
With Selection
.MergeCells = True
End With


ActiveSheet.[A11] = "May" 'names cell A11
Range("A11:B11").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a12] = "June" 'names cell A12
Range("A12:B12").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a13] = "July" 'names cell A13
Range("A13:B13").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[A14] = "August" 'names cell A14
Range("A14:B14").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a15] = "September" 'names cell A15
Range("A15:B15").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a16] = "October" 'names cell A16
Range("A16:B16").Select 'merges cell range
With Selection
.MergeCells = True
End With


ActiveSheet.[A17] = "November" 'names cell A17
Range("A17:B17").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a18] = "December" 'names cell A18
Range("A18:B18").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a19] = "January" 'names cell A19
Range("A19:B19").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[A20] = "February" 'names cell A20
Range("A20:B20").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[a21] = "March" 'names cell A21
Range("A21:B21").Select 'merges cell range
With Selection
.MergeCells = True
End With

ActiveSheet.[A22] = "TOTAL:" 'names cell A22
Range("A22:B22").Select 'merges cell range
With Selection
.MergeCells = True
End With

Range("A10:A22").Select 'Adjusts month cells width
With Selection
.RowHeight = 26.25
End With








End With

Columns("A:A").ColumnWidth = 8.29 'Sets column widths
Columns("B:B").ColumnWidth = 4.71
Columns("C:C").ColumnWidth = 8.43
Columns("D:D").ColumnWidth = 9.29
Columns("E:E").ColumnWidth = 7.14
Columns("F:F").ColumnWidth = 7.57
Columns("G:G").ColumnWidth = 8.43
Columns("H:H").ColumnWidth = 6.57
Columns("I:I").ColumnWidth = 7
Columns("J:J").ColumnWidth = 6.71
Columns("K:K").ColumnWidth = 15.29

Range("A1:k52").Select 'Makes range bold
With Selection.Font.Bold = True
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With ActiveSheet.PageSetup 'this resets the margins
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments

.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With

Range("D10").Formula = "='" & Worksheets(1).Name & "'!G4"

Next person
End With

With Destwb
.SaveAs FolderName _
& "\" & Destwb.Sheets(1).Name & FileExtStr, _
FileFormat:=FileFormatNum

.Close False
End With

End If
GoToNextSheet:
Next sh

MsgBox "You can find the files in " & FolderName

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


it is the line just before "next person" that i need to sort out. as stated before it needs to pick up the data in g4 for the 1st person then g5 for the next person etc the macro as it is now picks up the data from g4 and puts it in each persons sheet.
 

repairman615

Well-known Member
Joined
Dec 21, 2009
Messages
1,885
Hello,

Have a look at the DIM i as interger at top, then down a little you will see i = 0. Now near the bottom you will find the formula with a 4 + i at the end, then below a i = i + 1.

I did try to clean up the code some...without being able to test it I am not 100%.

See how it does for you.
Try on a copy:


<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Copy_Every_Sheet_To_New_Workbook()<br><SPAN style="color:#007F00">'Working in 97-2010</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> FileExtStr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> FileFormatNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> Sourcewb <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> Destwb <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> sh <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> DateString <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> FolderName <SPAN style="color:#00007F">As</SPAN> String<br><SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br><br>i = 0<br><br>    <SPAN style="color:#00007F">With</SPAN> Application<br>        .ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        .EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        .Calculation = xlCalculationManual<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Copy every sheet from the workbook with this macro</SPAN><br><SPAN style="color:#00007F">Set</SPAN> Sourcewb = ThisWorkbook<br><br><SPAN style="color:#007F00">'Create new folder to save the new files in</SPAN><br>DateString = Format(Now, "yyyy-mm-dd")<br>FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString<br>MkDir FolderName<br><br><SPAN style="color:#007F00">'Copy every visible sheet to a new workbook</SPAN><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> sh <SPAN style="color:#00007F">In</SPAN> Sourcewb.Worksheets<br><br><SPAN style="color:#007F00">'If the sheet is visible then copy it to a new workbook</SPAN><br><SPAN style="color:#00007F">If</SPAN> sh.Visible = -1 <SPAN style="color:#00007F">Then</SPAN><br>sh.Copy<br><br><SPAN style="color:#007F00">'Set Destwb to the new workbook</SPAN><br><SPAN style="color:#00007F">Set</SPAN> Destwb = ActiveWorkbook<br><br><SPAN style="color:#007F00">'Determine the Excel version and file extension/format</SPAN><br><SPAN style="color:#00007F">With</SPAN> Destwb<br><SPAN style="color:#00007F">If</SPAN> Val(Application.Version) < 12 <SPAN style="color:#00007F">Then</SPAN><br><SPAN style="color:#007F00">'You use Excel 97-2003</SPAN><br>FileExtStr = ".xls": FileFormatNum = -4143<br><SPAN style="color:#00007F">Else</SPAN><br><SPAN style="color:#007F00">'You use Excel 2007-2010</SPAN><br><SPAN style="color:#00007F">If</SPAN> Sourcewb.Name = .Name <SPAN style="color:#00007F">Then</SPAN><br>MsgBox "Your answer is NO in the security dialog"<br><SPAN style="color:#00007F">GoTo</SPAN> GoToNextSheet<br><SPAN style="color:#00007F">Else</SPAN><br><SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Sourcewb.FileFormat<br><SPAN style="color:#00007F">Case</SPAN> 51: FileExtStr = ".xlsx": FileFormatNum = 51<br><SPAN style="color:#00007F">Case</SPAN> 52:<br><SPAN style="color:#00007F">If</SPAN> .HasVBProject <SPAN style="color:#00007F">Then</SPAN><br>FileExtStr = ".xlsm": FileFormatNum = 52<br><SPAN style="color:#00007F">Else</SPAN><br>FileExtStr = ".xlsx": FileFormatNum = 51<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">Case</SPAN> 56: FileExtStr = ".xls": FileFormatNum = 56<br><SPAN style="color:#00007F">Case</SPAN> Else: FileExtStr = ".xlsb": FileFormatNum = 50<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Change all cells in the worksheet to values if you want</SPAN><br><SPAN style="color:#007F00">'If Destwb.Sheets(1).ProtectContents = False Then</SPAN><br><SPAN style="color:#007F00">' With Destwb.Sheets(1).UsedRange</SPAN><br><SPAN style="color:#007F00">' .Cells.Copy</SPAN><br><SPAN style="color:#007F00">' .Cells.PasteSpecial xlPasteValues</SPAN><br><SPAN style="color:#007F00">' .Cells(1).Select</SPAN><br><SPAN style="color:#007F00">' End With</SPAN><br><SPAN style="color:#007F00">' Application.CutCopyMode = False</SPAN><br><SPAN style="color:#007F00">'End If</SPAN><br><br><br><SPAN style="color:#007F00">'Save the new workbook and close it</SPAN><br><SPAN style="color:#00007F">With</SPAN> Destwb<br><br><br><SPAN style="color:#00007F">Dim</SPAN> person <SPAN style="color:#00007F">As</SPAN> Range, namerange <SPAN style="color:#00007F">As</SPAN> Range <SPAN style="color:#007F00">'create two variables of type range</SPAN><br>Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'deletes on sreen warning messages</SPAN><br><br><br><SPAN style="color:#00007F">Set</SPAN> person = Sheets(1).Range("A4") <SPAN style="color:#007F00">'sets the number of rows with peoples names in them as a range`</SPAN><br><SPAN style="color:#00007F">Set</SPAN> namerange = Range(person, person.End(xlDown))<br><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> person <SPAN style="color:#00007F">In</SPAN> namerange <SPAN style="color:#007F00">'start of loop that creates new worksheets</SPAN><br>Sheets.Add AFTER:=Sheets(Sheets.Count) <SPAN style="color:#007F00">'creates a new worksheet</SPAN><br>Sheets(Sheets.Count).Name = person.Value <SPAN style="color:#007F00">' renames the new worksheet</SPAN><br><br>Range("A1:C2").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'THIS SECTION MERGES A1 TO C2</SPAN><br><br>ActiveSheet.[A1] = "SCHOOL NAME" <SPAN style="color:#007F00">'Names cell A1</SPAN><br><br>Range("D1:F2").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a3] = "EMPLOYEE NAME" <SPAN style="color:#007F00">'names cell A3</SPAN><br><br>Range("A3:C3").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("A7:K7").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'THIS SECTION MERGES RANGE</SPAN><br><br>ActiveSheet.[D3] = person.Value <SPAN style="color:#007F00">'puts Name in cell A1</SPAN><br><br>Range("D3:F3").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[A4] = "NI NUMBER" <SPAN style="color:#007F00">'names cell A4</SPAN><br><br>Range("A4:C4").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("D4:F4").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a5] = "PAYROLL NUMBER" <SPAN style="color:#007F00">'names cell A5</SPAN><br><br>Range("A5:C5").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("D5:F5").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a6] = "JOB TITLE" <SPAN style="color:#007F00">'names cell A6</SPAN><br><br>Range("A6:C6").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("D6:F6").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[G1] = "SCHOOL CODE" <SPAN style="color:#007F00">'names cell G1</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Range("G1:G2")  <SPAN style="color:#007F00">'merges cell range and wraps text</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>Range("H1:I2").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[J1] = "YEAR" <SPAN style="color:#007F00">'names cell J1</SPAN><br><br>Range("J1:J2").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("K1:K2").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[K3] = "DATE" <SPAN style="color:#007F00">'names cell K3</SPAN><br><br>ActiveSheet.[g4] = "COMPLETED BY" <SPAN style="color:#007F00">'names cell G4</SPAN><br><br>Range("G4:H4").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("I4:J4").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[G5] = "CHECKED BY" <SPAN style="color:#007F00">'names cell G5</SPAN><br><br>Range("G5:H5").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("I5:J5").MergeCells = <SPAN style="color:#00007F">True</SPAN>  <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("G6:K6").Interior.ColorIndex = 1 <SPAN style="color:#007F00">'.Select 'blacks out range cells</SPAN><br><SPAN style="color:#007F00">'With Selection.Interior</SPAN><br><SPAN style="color:#007F00">'.ColorIndex = 1</SPAN><br><SPAN style="color:#007F00">'End With</SPAN><br><br>Range("G3:J3").Interior.ColorIndex = 1 <SPAN style="color:#007F00">'.Select 'blacks out range cells</SPAN><br><br>ActiveSheet.[A8] = "MONTH" <SPAN style="color:#007F00">'names cell A8</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Range("A8:B9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[C8] = "CONS (£)" <SPAN style="color:#007F00">'names cell C8</SPAN><br><br><SPAN style="color:#007F00">'.Select 'merges cell range</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("C8:C9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[D8] = "PENSION. PAY" <SPAN style="color:#007F00">'names cell D8</SPAN><br><br><SPAN style="color:#007F00">'.Select 'merges cell PAY and wraps text</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("D8:D9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'THIS SECTION MERGES A1 TO C2</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[E8] = "SPINAL POINT" <SPAN style="color:#007F00">'names cell E8</SPAN><br><br><SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES SPINAL POINT</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("E8:E9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[G8] = "HOURS" <SPAN style="color:#007F00">'names cell G8</SPAN><br><br><SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES HOURS</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("G8:H8") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[F8] = "F/T SALARY" <SPAN style="color:#007F00">'names cell F8</SPAN><br><SPAN style="color:#007F00">'.Select</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("F8:F9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'THIS SECTION MERGES F/T SALARY</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><br>ActiveSheet.[G9] = "WORKED" <SPAN style="color:#007F00">'names cell G9</SPAN><br>ActiveSheet.[H9] = "PAID" <SPAN style="color:#007F00">'names cell H9</SPAN><br>ActiveSheet.[I8] = "WEEKS PAID" <SPAN style="color:#007F00">'names cell I8</SPAN><br><br><SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES WEEKS PAID</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("I8:I9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[J8] = "TOTAL WEEKS" <SPAN style="color:#007F00">'names cell J8</SPAN><br><br> <SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES TOTAL WEEKS</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("J8:J9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[K8] = "NOTES" <SPAN style="color:#007F00">'names cell K8</SPAN><br><br><SPAN style="color:#007F00">'.Select</SPAN><br><SPAN style="color:#00007F">With</SPAN> Range("K8:K9") <SPAN style="color:#007F00">'Selection</SPAN><br>.MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'THIS SECTION MERGES Notes</SPAN><br>.WrapText = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>ActiveSheet.[a23] = "COMMENTS" <SPAN style="color:#007F00">'names cell A23</SPAN><br><br>Range("A23:K23").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES COMMENTS</SPAN><br><br>Range("A24:K34").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES A1 TO C2</SPAN><br><br>ActiveSheet.[A35] = "CALCULATIONS" <SPAN style="color:#007F00">'names cell A35</SPAN><br><br>Range("A35:K35").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'THIS SECTION MERGES A1 TO C2</SPAN><br><br>ActiveSheet.[a10] = "April" <SPAN style="color:#007F00">'names cell A10</SPAN><br><br>Range("A10:B10").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'merges cell range</SPAN><br><br>ActiveSheet.[A11] = "May" <SPAN style="color:#007F00">'names cell A11</SPAN><br>Range("A11:B11").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'merges cell range</SPAN><br><br>ActiveSheet.[a12] = "June" <SPAN style="color:#007F00">'names cell A12</SPAN><br><br>Range("A12:B12").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'.Select 'merges cell range</SPAN><br><br>ActiveSheet.[a13] = "July" <SPAN style="color:#007F00">'names cell A13</SPAN><br><br>Range("A13:B13").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[A14] = "August" <SPAN style="color:#007F00">'names cell A14</SPAN><br><br>Range("A14:B14").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a15] = "September" <SPAN style="color:#007F00">'names cell A15</SPAN><br><br>Range("A15:B15").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a16] = "October" <SPAN style="color:#007F00">'names cell A16</SPAN><br>Range("A16:B16").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[A17] = "November" <SPAN style="color:#007F00">'names cell A17</SPAN><br><br>Range("A17:B17").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a18] = "December" <SPAN style="color:#007F00">'names cell A18</SPAN><br><br>Range("A18:B18").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a19] = "January" <SPAN style="color:#007F00">'names cell A19</SPAN><br><br>Range("A19:B19").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[A20] = "February" <SPAN style="color:#007F00">'names cell A20</SPAN><br><br>Range("A20:B20").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[a21] = "March" <SPAN style="color:#007F00">'names cell A21</SPAN><br><br>Range("A21:B21").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>ActiveSheet.[A22] = "TOTAL:" <SPAN style="color:#007F00">'names cell A22</SPAN><br><br>Range("A22:B22").MergeCells = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'merges cell range</SPAN><br><br>Range("A10:A22").RowHeight = 26.25 <SPAN style="color:#007F00">'.Select 'Adjusts month cells width</SPAN><br><br><br>Columns("A:A").ColumnWidth = 8.29 <SPAN style="color:#007F00">'Sets column widths</SPAN><br>Columns("B:B").ColumnWidth = 4.71<br>Columns("C:C").ColumnWidth = 8.43<br>Columns("D:D").ColumnWidth = 9.29<br>Columns("E:E").ColumnWidth = 7.14<br>Columns("F:F").ColumnWidth = 7.57<br>Columns("G:G").ColumnWidth = 8.43<br>Columns("H:H").ColumnWidth = 6.57<br>Columns("I:I").ColumnWidth = 7<br>Columns("J:J").ColumnWidth = 6.71<br>Columns("K:K").ColumnWidth = 15.29<br><br>Range("A1:k52").Select <SPAN style="color:#007F00">'Makes range bold</SPAN><br><SPAN style="color:#00007F">With</SPAN> Selection.Font.Bold = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Selection.Borders(xlInsideVertical)<br>.LineStyle = xlContinuous<br>.Weight = xlThin<br>.ColorIndex = xlAutomatic<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">With</SPAN> Selection.Borders(xlInsideHorizontal)<br>.LineStyle = xlContinuous<br>.Weight = xlThin<br>.ColorIndex = xlAutomatic<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> ActiveSheet.PageSetup <SPAN style="color:#007F00">'this resets the margins</SPAN><br>.PrintTitleRows = ""<br>.PrintTitleColumns = ""<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>ActiveSheet.PageSetup.PrintArea = ""<br><SPAN style="color:#00007F">With</SPAN> ActiveSheet.PageSetup<br>.LeftHeader = ""<br>.CenterHeader = ""<br>.RightHeader = ""<br>.LeftFooter = ""<br>.CenterFooter = ""<br>.RightFooter = ""<br>.LeftMargin = Application.InchesToPoints(0)<br>.RightMargin = Application.InchesToPoints(0)<br>.TopMargin = Application.InchesToPoints(0)<br>.BottomMargin = Application.InchesToPoints(0)<br>.HeaderMargin = Application.InchesToPoints(0)<br>.FooterMargin = Application.InchesToPoints(0.511811023622047)<br>.PrintHeadings = <SPAN style="color:#00007F">False</SPAN><br>.PrintGridlines = <SPAN style="color:#00007F">False</SPAN><br>.PrintComments = xlPrintNoComments<br><br>.CenterHorizontally = <SPAN style="color:#00007F">True</SPAN><br>.CenterVertically = <SPAN style="color:#00007F">True</SPAN><br>.Orientation = xlPortrait<br>.Draft = <SPAN style="color:#00007F">False</SPAN><br>.PaperSize = xlPaperA4<br>.FirstPageNumber = xlAutomatic<br>.Order = xlDownThenOver<br>.BlackAndWhite = <SPAN style="color:#00007F">False</SPAN><br>.Zoom = 100<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>Range("D10").Formula = "='" & Worksheets(1).Name & "'!G" & 4 + i<br><br>i = i + 1<br><br><SPAN style="color:#00007F">Next</SPAN> person<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Destwb<br>.SaveAs FolderName _<br>& "\" & Destwb.Sheets(1).Name & FileExtStr, _<br>FileFormat:=FileFormatNum<br><br>.Close <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>GoToNextSheet:<br>Next sh<br><br>MsgBox "You can find the files in " & FolderName<br><br><SPAN style="color:#00007F">With</SPAN> Application<br>.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>.Calculation = xlCalculationAutomatic<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 

marleyps

New Member
Joined
Aug 29, 2003
Messages
38
thanks to all who helped with this query .
repairman615 you sorted it . the macro now does exactly what I wanted
I cant thank you enough. this is a great site thanks to all the people like you and the other experts who give freely of their advice and time.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,270
Messages
5,600,637
Members
414,398
Latest member
dhune

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top