Asbestos_Jen
New Member
Hello all! I'm relatively new to writing macros, mostly just recording or taking things from searches and modifying to (try to) fit my needs.
I'm using the code I found here at the link below, and have modified it and it almost does what I want.
I would like to change it to:
1. save the new file "report" to the directory the source file is in;
2. delete the default sheets created in the "report" file, without dialog boxes for each one (our system defaults to 3, I don't know if that's normal);
3. stop Excel from asking about "large amount of data on clipboard";
4. remove all named ranges from the Name Manage in the "report" file.
If these should all be separate threads, please let me know.
I would be grateful for any help!
Thanks!
Jen (sadly, still on Excel 2007)
I'm using the code I found here at the link below, and have modified it and it almost does what I want.
Range of selected cells copy & paste with all formats except formula; Save in a specific Folder; Name as a Cell ValueHi All, I have a work book with different sheets. I want to select some cells of the active sheet then copy those data into a new excel file with font type, color of the fonts & column width formats except formula, finally new excel file would save in the folder "C:\Users\XXX\ABC" giving file...
chandoo.org
|
1. save the new file "report" to the directory the source file is in;
2. delete the default sheets created in the "report" file, without dialog boxes for each one (our system defaults to 3, I don't know if that's normal);
3. stop Excel from asking about "large amount of data on clipboard";
4. remove all named ranges from the Name Manage in the "report" file.
If these should all be separate threads, please let me know.
I would be grateful for any help!
Code:
Sub Demo()
'modified from https://chandoo.org/forum/threads/range-of-selected-cells-copy-paste-with-all-formats-except-formula-save-in-a-specific-folder-name-as-a-cell-value.44527/post-265782
Dim wb As Workbook
Dim fName As String
Dim fPath As String: fPath = "C:\Users\REDACTED" 'CHANGE TO \current directory\ IN FINAL VERSION JD
Dim obj
OptimizeVBA True
Set wb = Workbooks.Add
With ThisWorkbook.Sheets("XLSTemp") 'changed sheetname JD
fName = .Range("Z8").Text 'changed range JD
.Copy , wb.Sheets(1)
End With
With wb
Call DeleteRows 'delete rows that say "Delete"
.Sheets("Sheet1").Delete
.Sheets("Sheet2").Delete 'Added line JD
.Sheets("Sheet3").Delete 'Added line JD
.SaveAs fPath & fName & ".xlsx", 51
With .Sheets("XLSTemp") 'changed sheetname JD
.Range("U:AB").Delete 'changed range JD
.Range("A:T").Copy 'changed range JD
.Range("A1").PasteSpecial xlValues
For Each obj In .Shapes
obj.Delete
Next
End With
'Call ProtectSheet() goes here? JD
.Close True
End With
OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not (isOn)
Application.DisplayAlerts = Not (isOn)
Application.ScreenUpdating = Not (isOn)
End Sub
Sub DeleteRows()
'Modified from:
'https://www.mrexcel.com/board/threads/vba-delete-rows-based-on-cell-value.1171142/post-5692643
'Joe4 MyDeleteMacro()
Dim lr As Long, lr2 As Long
Application.ScreenUpdating = False
' Find last row with data in column P (U in my case)
lr = Cells(Rows.Count, "U").End(xlUp).Row
' Hide all rows not equal to zero (Delete)
Columns("U:U").AutoFilter
ActiveSheet.Range("$U$1:$U$" & lr).AutoFilter Field:=1, Criteria1:="Delete"
' Find last row in column P with data after filter (U in my case)
lr2 = Cells(Rows.Count, "U").End(xlUp).Row
' Exit sub if no data to delete data (only header visible)
If lr2 = 2 Then Exit Sub
' Delete unhidden data
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
' Remove filter
Range("U1").AutoFilter
Application.ScreenUpdating = True
End Sub
Sub ProtectSheet()
Dim Ws As Worksheet
Set Ws = Worksheets("XLSTemp")
Ws.Protect Password:="MyPW"
End SubThanks!
Jen (sadly, still on Excel 2007)
