I want to create a macro autofit all rows and columns with values in them in across all worksheets in a workbook. This is what I have so far, I am stuck. Thank you in advance.
Sub AutoFitColumnsRows()
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Next
starting_ws.Activate
End Sub
I am not sure why you need the other variables you have defined, but the basic loop looks like this:
For Each ws In ThisWorkbook.Worksheets
ws.Cells.EntireRow.AutoFit
ws.Cells.EntireColumn.AutoFit
Next
Related
I am trying to write a macro that will look through all sheets in the workbook, and if a sheet name contains "blank", to rename that sheet with the value in cell C1.
Here is what I have so far:
Sub Rename()
Dim ws As Worksheet
Dim sheetBlank As Worksheet
Set sheetBlank = ActiveWorkbook.ActiveSheet
Dim nameCell As Range
Set nameCell = ActiveSheet.Range("C1")
For Each ws In Sheets
If sheetBlank.Name Like "*blank*" Then
sheetBlank.Name = nameCell.Value
End If
Next ws
End Sub
Now, this does rename the first active sheet, but it is not making any changes to the rest of them. What am I doing wrong?
You're referring to the wrong worksheet:
Sub Rename()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*blank*" Then
ws.Name = ws.Range("C1").Value
End If
Next ws
End Sub
You set your objects outside the loop and never touch them again.
If you're going to use "ActiveSheet" you need to .Activate each sheet in order to work, but that's not a good approach since your iterator (ws) represents the sheet object.
Public Sub Rename()
Dim Ws As Worksheet
For Each Ws In Worksheets
If InStr(1, Ws.Name, "blank", vbTextCompare) > 0 Then _
Ws.Name = Ws.Range("C1").Value2
Next Ws
End Sub
I need help with the code. I want to merge all rows from few sheets except header in one sheet in Excel.
Here is the code:
Dim ws As Worksheet
Dim sh As Worksheet
Set sh = Sheets("P&L_consolidation")
For Each ws In Sheets
If ws.Name <> "Zero's" Then
ws.Range("A2", ws.Range("U"& Rows.Count).End(xlUp)).Copy sh.Range("A"& Rows.Count).ENd(xlUp)(2)
End if
Next ws
This code works if the sheet has some data in it, but the problem is if some sheet contains only header then this code copy that header and paste it to the merged sheet. In that case I just want to skip that sheet.
Please, can somebody help me?
Something like this should work for you:
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsDest = wb.Worksheets("P&L_consolidation")
For Each ws In wb.Worksheets
If ws.Name <> "Zero's" Then
With ws.Range("A2", ws.Cells(ws.Rows.Count, "U").End(xlUp))
If .Row >= 2 Then .Copy wsDest.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
End With
End If
Next ws
End Sub
My problem is looping through several worksheets in a workbook.
I need to save the macro in my personal workbook, but if I do this, it loops through the same worksheet until it reaches the sheet count.
If I move the code to the current workbook, it works beautifully. I have investigated writing a macro to copy the module from personal workbook to the current workbook, but for other users this module will simply be saved in another workbook that is only open in the background to run the module.
How do I get this to loop through all worksheets in another workbook, when the code is saved to a module in my personal workbook, or simply saved in another workbook that is open in the background?
Code below:
Sub WorksheetLoop()
' Loop Through Worksheets, Add Totals
Dim LastRow As Long
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
' Loop Sum Formula Through All Worksheets
For Each ws In ThisWorkbook.Worksheets
ws.Activate
'Now my code, the do something, (I have simplified this part since this _
works, its the loop that's broken)
'Insert new blank rows
Rows("1:6").Select
Selection.Insert Shift:=xlDown
'Got to next worksheet, but it will not!
Next
End Sub
This code has a bit different logic, but try it if it works:
Sub WorksheetLoop()
' Loop Through Worksheets, Add Totals
Dim LastRow As Long
Dim ws As Worksheet
Dim starting_ws As Worksheet
Dim path As String
Dim WorkingFile As Workbook
' Select the file you will manipulate to surely be in the correct WB.
path = Application.GetOpenFilename(FileFilter:="Excel Files (*.*), *.*", Title:="Please select a file you want to modify")
Workbooks.Open path
Set WorkingFile = ActiveWorkbook
For Each ws In WorkingFile.Worksheets
ws.Rows("1:6").Insert Shift:=xlDown
'Rest of the code
Next
End Sub
Here is the working code, Now to compare it to what was originally posted code.
Thanks again Vinnie and Gordon!
Sub Step_3_Add_Subtotals()
' Loop Through Worksheets, Add Totals
Dim LastRow As Long
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
' Loop Sum Formula Through All Worksheets
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
'Now my code, the do something
'Insert new blank rows
Rows("1:6").Select
Selection.Insert Shift:=xlDown
'Copy current headers, paste them in K3:Q3
Range("K7:Q7").Select
Selection.Copy
Range("K3").Select
ActiveSheet.Paste
'Got to next worksheet, and now it does!
Next
starting_ws.Activate
End Sub
I want to delete the first column(A:A) in each sheet except in the first or the current sheet. Can somebody help me.
I used the following code which deletes first column from each sheet.
Sub deletefirstcolum()
Dim ws As Worksheet
For Each ws In Sheets
ws.Cells(1, 1).EntireColumn.Delete
Next ws
End Sub
Please help. How do I exclude first or current sheet.
Put an If condition on the worksheet:
Sub deletefirstcolum()
Dim ws As Worksheet
For Each ws In Sheets
If Not ws Is ActiveSheet Then
ws.Cells(1, 1).EntireColumn.Delete
End If
Next ws
End Sub
Test whether ws = to the active sheet:
Sub deletefirstcolum()
Dim aWs As Worksheet
Set aWs = ActiveSheet
Dim ws As Worksheet
For Each ws In Sheets
If aWs.Name <> ws.Name Then
ws.Cells(1, 1).EntireColumn.Delete
End If
Next ws
End Sub
I am trying to copy column A from one sheet "OPT1"
to the same column in multiple sheets - "OPT1_1", OPT1_2" etc
but it doesn't seem to like the range?
Sub Copy_MN()
Dim ws As Worksheet
For Each ws In Worksheets
Sheets("OPT1").Select
Range("A:A").Copy
If ws.Name Like "OPT1_*" Then
'ActiveSheet.Select
ws.Range("A:A").Select
ActiveSheet.Paste
End If
Next ws
End Sub
Here's my proposition:
Sub Copy_MN()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.name Like "OPT1_*" Then
ws.Range("A:A").Value = Sheets("OPT1").Range("A:A").Value
End If
Next ws
End Sub