I've got a script that deletes rows 1-4 on on every worksheet, but would like it to skip a worksheet if its name is "Sheet1"
Sub RowDelete()
Dim xWs As Worksheet
Set xWs = ActiveSheet
ThisWorkbook.Worksheets.Select
Rows("1:4").Select
Selection.Delete
xWs.Select
End Sub
Run it through a FOR EACH Loop:
Sub RowDelete()
Dim xWs As Worksheet
For Each xWs In Worksheets
If xWs.Name <> "Sheet1" Then
xWs.Rows("1:4").Delete
End If
Next xWs
End Sub
Btw, try to learn coding without using .Select.
Related
I wanted to write a macro which will create AutoFilter, if not present, drop filters and delete specific range in some tabs in my workbook.
I created this code but somehow it doesn't work - data gis deleted only from one tab instead of all that are not listed in If statement. Please help!
Sub ClearTabs()
Dim rng As Range
Dim ws As Worksheet
Set rng = Range("B9:AK100")
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "lastfile" And ws.Name <> "Sheet1" And ws.Name <> "Sheet2" Then
If Not ws.AutoFilterMode Then
ws.Range("B8:AK8").AutoFilter
End If
ws.AutoFilter.ShowAllData
rng.ClearContents
End If
Next ws
End Sub
Following my comment above, You need to set the Range (Set rng = Range("B9:AK100")) inside the For Each ws In ThisWorkbook.Sheets loop.
Code:
Sub ClearTabs()
Dim rng As Range
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
With ws
Select Case .Name
Case "lastfile", "Sheet1", "Sheet2"
' do nothing
Case Else
Set rng = .Range("B9:AK100")
If Not .AutoFilterMode Then
.Range("B8:AK8").AutoFilter
End If
.AutoFilter.ShowAllData
rng.ClearContents
End Select
End With
Next ws
End Sub
you can avoid dimming and setting rng and go like this
Option Explicit
Sub ClearTabs()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
With ws
If .Name <> "lastfile" And .Name <> "Sheet1" And .Name <> "Sheet2" Then
If .AutoFilterMode Then
.AutoFilter.ShowAllData
Else
.Range("B8:AK8").AutoFilter
End If
.Range("B9:AK100").ClearContents
End If
End With
Next
End Sub
I would like to save a number of worksheets from the current workbook to a different workbook and exclude a sheet named "buttons" (in current one) from that saving process.
Can anybody help please? The number of worksheets is changeable FYI.
Below is what I have so far which include all the sheets from current workbook.
Sub SaveAs()
D1 = VBA.Format(Now, "mm_DD_yyyy")
For Each ws In Application.Workbooks
ws.SaveAs Filename:="C:\Users\e2309\Desktop\Andy's\GBB_Report_" & D1 & ".csv"
Next ws
Application.Quit
End Sub
Or more directly
copy the entire workbook
delete the redundant sheet
code
Sub Simpler()
Dim wb As Workbook
Dim strFile As String
strFile = "C:\temp\yourfile.xlsm"
ThisWorkbook.SaveAs strFile, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
ThisWorkbook.Sheets("buttons").Delete
Application.DisplayAlerts = True
End Sub
This might get you a little closer. Note this is not complete and very untested.
Sub work()
Dim WB As Workbook
Dim Nwb As Workbook
Dim WS As Worksheet
Set Nwb = New Workbook
Set WB = ThisWorkbook
For Each WS In WB.Sheets
If WS.Name <> "Don't copy" Then
WS.Copy Nwb.Sheets("sheet1")
End If
Next
Nwb.Save
End Sub
What I am trying to do seems basic enough, however I don't know where I am going wrong with the code.
I want to run the selected cell through a loop of the worksheets and select the worksheet that matches the selected cell located in cell B1.
Dim SelectedCell as Range
Dim ws As Worksheet
Set SelectedCell = Range(ActiveCell.Address)
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("B1").Value = SelectedCell.Value Then
ActiveSheet.Select
End If
Next ws
End Sub
Thanks in advance for all the help!
Try instead
Dim ws As Worksheet
SelectedCell = ActiveCell
For Each ws In ActiveWorkbook.Worksheets
If ws.cells(1,2) = SelectedCell Then
ws.Select
End If
Next ws
End Sub
Select cell run macro will select the sheet name that matches the selected cell. (Case sensitive)
Dim SelectCell As String
Dim ws As Worksheet
SelectCell = ActiveCell.Value2
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = SelectCell Then
ws.Select
End ID
Next ws
I have an error message of 'Object Required' when I run this sub. I have a version for copying each specific sheet, which works fine, but this sub is for all sheets within the WB ie to copy each one's WholePrintArea and paste it into a new sheet in the new WB. Thanks...
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Dim SH As Worksheet
For Each SH In MyBook.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
Try do something like this (the problem was that you trying to use MyBook.Worksheets, but MyBook is not a Workbook object, but string, containing workbook name. I've added new varible Set WB = ActiveWorkbook, so you can use WB.Worksheets instead MyBook.Worksheets):
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Set WB = ActiveWorkbook
Dim SH As Worksheet
For Each SH In WB.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
But your code doesn't do what you want: it doesen't copy something to a new WB. So, the code below do it for you:
Sub NewWBandPasteSpecialALLSheets()
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Set wb = ThisWorkbook
Workbooks.Add ' Open a new workbook
Set wbNew = ActiveWorkbook
On Error Resume Next
For Each sh In wb.Worksheets
sh.Range("WholePrintArea").Copy
'add new sheet into new workbook with the same name
With wbNew.Worksheets
Set shNew = Nothing
Set shNew = .Item(sh.Name)
If shNew Is Nothing Then
.Add After:=.Item(.Count)
.Item(.Count).Name = sh.Name
Set shNew = .Item(.Count)
End If
End With
With shNew.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
Rethink your approach. Why would you copy only part of the sheet? You are referring to a named range "WholePrintArea" which doesn't exist. Also you should never use activate, select, copy or paste in your script. These make the "script" vulnerable to user actions and other simultaneous executions. In worst case scenario data ends up in wrong hands.
This worked for me (I added an "if sheet visible" because in my case I wanted to skip hidden sheets)
Sub Create_new_file()
Application.DisplayAlerts = False
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Dim pname, parea As String
Set wb = ThisWorkbook
Workbooks.Add
Set wbNew = ActiveWorkbook
For Each sh In wb.Worksheets
pname = sh.Name
If sh.Visible = True Then
sh.Copy After:=wbNew.Sheets(Sheets.Count)
wbNew.Sheets(Sheets.Count).Cells.ClearContents
wbNew.Sheets(Sheets.Count).Cells.ClearFormats
wb.Sheets(sh.Name).Activate
Range(sh.PageSetup.PrintArea).Select
Selection.Copy
wbNew.Sheets(pname).Activate
Range("A1").Select
With Selection
.PasteSpecial (xlValues)
.PasteSpecial (xlFormats)
.PasteSpecial (xlPasteColumnWidths)
End With
ActiveSheet.Name = pname
End If
Next
wbNew.Sheets("Hoja1").Delete
Application.DisplayAlerts = True
End Sub
Since you are copying all worksheet, how about:
Copy & Paste (X)
SaveAS (O)
Sub Export()
Application.DisplayAlerts = False
On Error Resume Next
Dim NewWB As String
NewWB = Sheets("Control").Range("B42")
ActiveWorkbook.SaveAs Filename:=NewWB, FileFormat:=xlWorkbookNormal
ActiveWorkbook.Sheets("Control").Delete
End Sub
I had a worksheet "Control" handling all variant, you may change it yourself
On the other hand, if you really wish to use COPY & PASTE, you could use ARRAY
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=FolderPath & ExcelName & ".xlsx", FileFormat:=xlNormal
Workbooks(ExcelOrigin).Activate
Sheets(Array("for coversheet", "Pivot", "CCA", "FRR", "CRS", "GSA", "Inv Summary", "UploadtoJDE", "Comat")).Copy Before:=Workbooks(ExcelName).Sheets(1)
Sheets("Sheet1").Delete
Remember to Dim (FolderPath,ExcelName,ExcelOrigin) as String
As equal them to your file name & file path
[ i can't type in those here because of error ]
Here is my code. I'm new to VBA so, I am unsure how to iterate through multiple pages.
Here's my code:
Dim ws As Worksheet
Sub spellCheck()
For Each ws In ActiveWorkbook.Worksheets
Cells.CheckSpelling
Next
End Sub
Try this (this will simply activate each sheet):
Sub spellCheck()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
' Do stuff...
Next
End Sub