inserting a formula into a cell

marleyps · Mar 13, 2011

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.

repairman615 · Mar 13, 2011

Hello,

I may have misunderstood but here is a line:

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

Does that work as expected?

mole999 · Mar 13, 2011

take the speech marks off g4

Peter_SSs · Mar 14, 2011

mole999 said:
take the speech marks off g4

?

repairman615 said:
Hello,

I may have misunderstood but here is a line:

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

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"

marleyps · Mar 14, 2011

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 · Mar 14, 2011

marleyps said:
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.

marleyps said:
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 · Mar 14, 2011

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 · Mar 15, 2011

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:

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 Dim i As Integer i = 0 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").MergeCells = True 'THIS SECTION MERGES A1 TO C2 ActiveSheet.[A1] = "SCHOOL NAME" 'Names cell A1 Range("D1:F2").MergeCells = True 'merges cell range ActiveSheet.[a3] = "EMPLOYEE NAME" 'names cell A3 Range("A3:C3").MergeCells = True 'merges cell range Range("A7:K7").MergeCells = True 'THIS SECTION MERGES RANGE ActiveSheet.[D3] = person.Value 'puts Name in cell A1 Range("D3:F3").MergeCells = True 'merges cell range ActiveSheet.[A4] = "NI NUMBER" 'names cell A4 Range("A4:C4").MergeCells = True 'merges cell range Range("D4:F4").MergeCells = True 'merges cell range ActiveSheet.[a5] = "PAYROLL NUMBER" 'names cell A5 Range("A5:C5").MergeCells = True 'merges cell range Range("D5:F5").MergeCells = True 'merges cell range ActiveSheet.[a6] = "JOB TITLE" 'names cell A6 Range("A6:C6").MergeCells = True 'merges cell range Range("D6:F6").MergeCells = True 'merges cell range ActiveSheet.[G1] = "SCHOOL CODE" 'names cell G1 With Range("G1:G2") 'merges cell range and wraps text .MergeCells = True .WrapText = True End With Range("H1:I2").MergeCells = True 'merges cell range ActiveSheet.[J1] = "YEAR" 'names cell J1 Range("J1:J2").MergeCells = True 'merges cell range Range("K1:K2").MergeCells = True 'merges cell range ActiveSheet.[K3] = "DATE" 'names cell K3 ActiveSheet.[g4] = "COMPLETED BY" 'names cell G4 Range("G4:H4").MergeCells = True 'merges cell range Range("I4:J4").MergeCells = True 'merges cell range ActiveSheet.[G5] = "CHECKED BY" 'names cell G5 Range("G5:H5").MergeCells = True 'merges cell range Range("I5:J5").MergeCells = True 'merges cell range Range("G6:K6").Interior.ColorIndex = 1 '.Select 'blacks out range cells 'With Selection.Interior '.ColorIndex = 1 'End With Range("G3:J3").Interior.ColorIndex = 1 '.Select 'blacks out range cells ActiveSheet.[A8] = "MONTH" 'names cell A8 With Range("A8:B9") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[C8] = "CONS (£)" 'names cell C8 '.Select 'merges cell range With Range("C8:C9") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[D8] = "PENSION. PAY" 'names cell D8 '.Select 'merges cell PAY and wraps text With Range("D8:D9") 'Selection .MergeCells = True .WrapText = True 'THIS SECTION MERGES A1 TO C2 End With ActiveSheet.[E8] = "SPINAL POINT" 'names cell E8 '.Select 'THIS SECTION MERGES SPINAL POINT With Range("E8:E9") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[G8] = "HOURS" 'names cell G8 '.Select 'THIS SECTION MERGES HOURS With Range("G8:H8") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[F8] = "F/T SALARY" 'names cell F8 '.Select With Range("F8:F9") '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 '.Select 'THIS SECTION MERGES WEEKS PAID With Range("I8:I9") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[J8] = "TOTAL WEEKS" 'names cell J8 '.Select 'THIS SECTION MERGES TOTAL WEEKS With Range("J8:J9") 'Selection .MergeCells = True .WrapText = True End With ActiveSheet.[K8] = "NOTES" 'names cell K8 '.Select With Range("K8:K9") 'Selection .MergeCells = True 'THIS SECTION MERGES Notes .WrapText = True End With ActiveSheet.[a23] = "COMMENTS" 'names cell A23 Range("A23:K23").MergeCells = True '.Select 'THIS SECTION MERGES COMMENTS Range("A24:K34").MergeCells = True '.Select 'THIS SECTION MERGES A1 TO C2 ActiveSheet.[A35] = "CALCULATIONS" 'names cell A35 Range("A35:K35").MergeCells = True '.Select 'THIS SECTION MERGES A1 TO C2 ActiveSheet.[a10] = "April" 'names cell A10 Range("A10:B10").MergeCells = True '.Select 'merges cell range ActiveSheet.[A11] = "May" 'names cell A11 Range("A11:B11").MergeCells = True '.Select 'merges cell range ActiveSheet.[a12] = "June" 'names cell A12 Range("A12:B12").MergeCells = True '.Select 'merges cell range ActiveSheet.[a13] = "July" 'names cell A13 Range("A13:B13").MergeCells = True 'merges cell range ActiveSheet.[A14] = "August" 'names cell A14 Range("A14:B14").MergeCells = True 'merges cell range ActiveSheet.[a15] = "September" 'names cell A15 Range("A15:B15").MergeCells = True 'merges cell range ActiveSheet.[a16] = "October" 'names cell A16 Range("A16:B16").MergeCells = True 'merges cell range ActiveSheet.[A17] = "November" 'names cell A17 Range("A17:B17").MergeCells = True 'merges cell range ActiveSheet.[a18] = "December" 'names cell A18 Range("A18:B18").MergeCells = True 'merges cell range ActiveSheet.[a19] = "January" 'names cell A19 Range("A19:B19").MergeCells = True 'merges cell range ActiveSheet.[A20] = "February" 'names cell A20 Range("A20:B20").MergeCells = True 'merges cell range ActiveSheet.[a21] = "March" 'names cell A21 Range("A21:B21").MergeCells = True 'merges cell range ActiveSheet.[A22] = "TOTAL:" 'names cell A22 Range("A22:B22").MergeCells = True 'merges cell range Range("A10:A22").RowHeight = 26.25 '.Select 'Adjusts month cells width 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 & "'!G" & 4 + i i = i + 1 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

marleyps · Mar 15, 2011

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.

inserting a formula into a cell

marleyps

New Member

Excel Facts

repairman615

Well-known Member

mole999

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

marleyps

New Member

Peter_SSs

MrExcel MVP, Moderator

marleyps

New Member

repairman615

Well-known Member

marleyps

New Member

Similar threads

Forum statistics

Share this page

inserting a formula into a cell

New Member

Excel Facts

Well-known Member

Well-known Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock