Sharid
Well-known Member
- Joined
- Apr 22, 2007
- Messages
- 1,064
- Office Version
- 2016
- Platform
- Windows
HI
Hoping someone can help, I had a similar problem yesterday and was able to get that fix with the support of this forum Mr Excel . I have been trying to apply the same principle used yesterday in this code, that I wrote some time back. However the new updates do not fully work and I am a bit stuck again.
Reason for change in code
I will be creating copies of worksheets and have to keep using this code over and over again about 50+ times. Rather than do that, a command button will add the changed data to Sheet10 Cells D33 + D34 and the code will be called up from a module, it will use the changes in Sheet10 Cells D33, D34 every time it is run (This Data will keep changing on each command button Click)
Each command button will place different data in Sheet10 Cells D33 + D34
These are the 5 parts that need Changing. The original code is commented out, FULL code is below
What the code is supposed to do
1) Create a copy of the Original Sheet, Format the header on the new sheet (Add Filter, Freezeframe, change font color of heading), Date/time stamp the new sheet, rename the new sheet tab with given name, Fill Blank cells with a hyphen.
If the original code is left in then it works FINE. I have got it to only half working with my changes. When I use my variation, a new workbook is created, however the new worksheet is Not Named, Dated, Timed, Data is not copied into it, nor is the workbook tab renamed to the new name, or freeze frame + filtered applied. The Original Sheet, from which the data was copied, ends up with the freeze frame and tab renamed.
Full code is below, With ORIGINAL CODE IN IT, but commented out
Thanks
Hoping someone can help, I had a similar problem yesterday and was able to get that fix with the support of this forum Mr Excel . I have been trying to apply the same principle used yesterday in this code, that I wrote some time back. However the new updates do not fully work and I am a bit stuck again.
Reason for change in code
I will be creating copies of worksheets and have to keep using this code over and over again about 50+ times. Rather than do that, a command button will add the changed data to Sheet10 Cells D33 + D34 and the code will be called up from a module, it will use the changes in Sheet10 Cells D33, D34 every time it is run (This Data will keep changing on each command button Click)
Each command button will place different data in Sheet10 Cells D33 + D34
VBA Code:
Command Button1_Click ()
Sheet10.Range("D33").Value = "Sheet1" ' The text "Sheet1" will be added to Sheet10 D33
Sheet10.Range("D34").Value = "Staff Data" ' The text "Staff Data" will be added to Sheet10 D34
Application.Run "Module2.CopySheet" ' Code is written once and called as a module and will get data from Sheet 10
End Sub
These are the 5 parts that need Changing. The original code is commented out, FULL code is below
VBA Code:
'######## IF Statement See if Sheet has Data in it ########### PART 1
'If Sheet1.Range("a2").Value = "" Then ' ******** ORIGINAL CODE ******
If Sheets(Sheets("Sheet10").Range("D33").Value).Range("A2").Value = "" Then
''' ########## Copy This Sheet ############ PART 2
'.Sheets("Sheet1").UsedRange.Copy ' ******** ORIGINAL CODE ******
.Sheets(Sheets("Sheet10").Range("D33").Value).UsedRange.Copy
''' ########## Name of New Sheet ############ PART 3
'ActiveWorkbook.Sheets(1).Name = "Staff Data" ' ******** ORIGINAL CODE ******
ActiveWorkbook.Sheets(1).Name = Sheets("Sheet10").Range("D34").Value
''' ############ column width ############# PART 4
'Worksheets("Staff Data").Columns("A:Z").ColumnWidth = 25 ' ******** ORIGINAL CODE ******
Worksheets(Sheets("Sheet10").Range("D34")).Value.Columns("A:Z").ColumnWidth = 25
''''' ########### Name of Sheet + DATE + TIME ########## PART 5
'ActiveWorkbook.SaveAs "Staff Data" & Format(Now, " dd_mm_yyyy HH_mm_ss") & ".xlsx" ' ******** ORIGINAL CODE ******
ActiveWorkbook.SaveAs Sheets("Sheet10").Range("D34") & Format(Now, " dd_mm_yyyy HH_mm_ss") & ".xlsx"
1) Create a copy of the Original Sheet, Format the header on the new sheet (Add Filter, Freezeframe, change font color of heading), Date/time stamp the new sheet, rename the new sheet tab with given name, Fill Blank cells with a hyphen.
If the original code is left in then it works FINE. I have got it to only half working with my changes. When I use my variation, a new workbook is created, however the new worksheet is Not Named, Dated, Timed, Data is not copied into it, nor is the workbook tab renamed to the new name, or freeze frame + filtered applied. The Original Sheet, from which the data was copied, ends up with the freeze frame and tab renamed.
Full code is below, With ORIGINAL CODE IN IT, but commented out
VBA Code:
'##### Export Staff DATA to excel #########
'######## IF Statement See if Sheet has Data in it ########### PART 1
'If Sheet1.Range("a2").Value = "" Then ' ******** ORIGINAL CODE ******
If Sheets(Sheets("Sheet10").Range("D33").Value).Range("A2").Value = "" Then
ExportError.show
Else
Application.SheetsInNewWorkbook = 1
Workbooks.Add
With ThisWorkbook
''' ########## Copy This Sheet ############ PART 2
'.Sheets("Sheet1").UsedRange.Copy ' ******** ORIGINAL CODE ******
.Sheets(Sheets("Sheet10").Range("D33").Value).UsedRange.Copy 'Copy this sheet
ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
''' ########## Name of New Sheet ############ PART 3
'ActiveWorkbook.Sheets(1).Name = "Staff Data" ' ******** ORIGINAL CODE ******
ActiveWorkbook.Sheets(1).Name = Sheets("Sheet10").Range("D34").Value
On Error Resume Next
''' ############ column width ############# PART 4
'Worksheets("Staff Data").Columns("A:Z").ColumnWidth = 25 ' ******** ORIGINAL CODE ******
Worksheets(Sheets("Sheet10").Range("D34")).Value.Columns("A:Z").ColumnWidth = 25
Range("A1:Z1").Font.Name = "Calibri"
Range("A1:Z1").HorizontalAlignment = xlCenter
Range("A1:Z1").Font.Color = vbWhite
Range("A1:Z1").Interior.ColorIndex = 16 '.Color = vbGreen
'''''Fill all BLANK CELLS with Hyphen
Dim r As Range, LastRow As Long
LastRow = Cells(Rows.Count, a).End(xlUp).Row
For Each r In Range("A1:Z1" & LastRow)
If r.Text = "" Then r.Value = "-"
Next r
''''' ########### Name of Sheet + DATE + TIME ########## PART 5
'ActiveWorkbook.SaveAs "Staff Data" & Format(Now, " dd_mm_yyyy HH_mm_ss") & ".xlsx" ' ******** ORIGINAL CODE ******
ActiveWorkbook.SaveAs Sheets("Sheet10").Range("D34") & Format(Now, " dd_mm_yyyy HH_mm_ss") & ".xlsx"
On Error Resume Next
''''''Freeze panel on new sheet
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
With Application.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
Application.ActiveWindow.FreezePanes = True
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Next ws
End With
End If
Thanks