Remove Paste Special from Macro

[rusted314]

Hi, I have the macro below that will take all of the Workbooks in a folder and copy the worksheet of my choice into a master document. The macro is setup to paste values and I need to have have the formulas included when the worksheets are copied. I tried removing the line of code " Sheets(c).Range("A1").PasteSpecial" but that didnt work. Can someone please modify this for me so the formulas are included when I run the macro?
Thanks



Sub Daily_Staffing_Rollup_PV()
Dim MyInput As String
MyInput = InputBox("What Day of The Week Do You Need?", _
"MyInputTitle", "Enter day here ie. Monday")
If MyInput = "Enter your input text HERE" Or _
MyInput = "" Then
Exit Sub
End If



Dim z As Long, e As Long
Dim f As String, b As String, c As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("master.xls").Sheets("Sheet1").Cells(1, 1) = "=cell(""filename"")"
Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Workbooks("master.xls").Sheets("Sheet1").Cells(2, 1).Select
f = Dir(Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Workbooks("master.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
b = Workbooks("master.xls").Sheets("Sheet1").Cells(e, 1)
If b <> ActiveWorkbook.Name Then
c = Mid(Left(b, Len(b) - 4), 1, 30)
Workbooks.Open Filename:=Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) & Workbooks("master.xls").Sheets("Sheet1").Cells(e, 1)
Worksheets(MyInput).UsedRange.Copy 'Change sheetname if it is incorrect
ActiveWorkbook.Close False
Sheets.Add.Name = c
Sheets(c).Range("A1").PasteSpecial
End If
Next e
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Worksheets.Add().Name = "Summary"
MsgBox "collating is complete and summary sheet added."
' Local Variables
Dim wks As Worksheet
Dim rngLinkCell As Range
Dim strSubAddress As String, strDisplayText As String
' Step 1 : Loop through all worksheets
' 1a : Clear all current hyperlinks
Worksheets("Summary").Range("A:A").ClearContents
' 1b : Create Linked index list
For Each wks In ActiveWorkbook.Worksheets
Set rngLinkCell = Worksheets("Summary").Range("A65536").End(xlUp)
If rngLinkCell <> "" Then Set rngLinkCell = rngLinkCell.Offset(1, 0)
strSubAddress = "'" & wks.Name & "'!A1"
strDisplayText = wks.Name
Worksheets("Summary").Hyperlinks.Add Anchor:=rngLinkCell, Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText
Next wks

End Sub

 

[Jameo]

Sub Daily_Staffing_Rollup_PV()
Dim MyInput As String
MyInput = InputBox("What Day of The Week Do You Need?", _
"MyInputTitle", "Enter day here ie. Monday")
If MyInput = "Enter your input text HERE" Or _
MyInput = "" Then
Exit Sub
End If
 
 
 
Dim z As Long, e As Long
Dim f As String, b As String, c As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("master.xls").Sheets("Sheet1").Cells(1, 1) = "=cell(""filename"")"
Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Workbooks("master.xls").Sheets("Sheet1").Cells(2, 1).Select
f = Dir(Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Workbooks("master.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
b = Workbooks("master.xls").Sheets("Sheet1").Cells(e, 1)
If b <> ActiveWorkbook.Name Then
c = Mid(Left(b, Len(b) - 4), 1, 30)
Workbooks.Open Filename:=Workbooks("master.xls").Sheets("Sheet1").Cells(1, 2) & Workbooks("master.xls").Sheets("Sheet1").Cells(e, 1)
Worksheets(MyInput).UsedRange.Copy 'Change sheetname if it is incorrect
ActiveWorkbook.Close False
Sheets.Add.Name = c
Sheets(c).Range("A1").PasteSpecial Paste:=xlPasteAll
End If
Next e
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Worksheets.Add().Name = "Summary"
MsgBox "collating is complete and summary sheet added."
' Local Variables
Dim wks As Worksheet
Dim rngLinkCell As Range
Dim strSubAddress As String, strDisplayText As String
' Step 1 : Loop through all worksheets
' 1a : Clear all current hyperlinks
Worksheets("Summary").Range("A:A").ClearContents
' 1b : Create Linked index list
For Each wks In ActiveWorkbook.Worksheets
Set rngLinkCell = Worksheets("Summary").Range("A65536").End(xlUp)
If rngLinkCell <> "" Then Set rngLinkCell = rngLinkCell.Offset(1, 0)
strSubAddress = "'" & wks.Name & "'!A1"
strDisplayText = wks.Name
Worksheets("Summary").Hyperlinks.Add Anchor:=rngLinkCell, Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText
Next wks
 
End Sub

 

[rusted314]

Thank you for the quick reply. Unfortunately it is still copying values only. Does anyone know how to copy the full worksheet in its original form with all formulas?

 

[rusted314]

Any other suggestions?? I still can not get the formulas to copy over.