Excel Macro Not Doing anything? - excel

This is my first excel macro (and first time working with VBScript), so it is most likely wrong, but I'm trying to go through each sheet in my workbook, and rename the sheet to the value of the sheets "A2" cell's value. As the name says, the function isn't doing anything when I run it. It is running however. Here is my code:
Sub RenameSheets()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
ActiveSheet.Name = ActiveSheet.Range("A2").Value
Next I
End Sub

Sub RenameSheets()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Dim WS As Worksheet
Set WS = ActiveWorkbook.Worksheets(I)
'Worksheet names can not be null
If Len(WS.Cells(2, 1)) > 0 Then
WS.Name = WS.Cells(2, 1)
End If
Next I
End Sub

You are not selecting the different sheets so ActiveSheet isn't changing. You can rewrite your function below to get the intended result:
Dim currentWorksheet as Worksheet
For Each currentWorksheet in ActiveWorkbook.Worksheets
currentWorksheet.name = currentWorksheet.Range("A2").Value
Next currentWorksheet
what is above is a for..each loop that will set currentWorksheet to each Worksheet in all of the Worksheets in the Workbook.

Related

Copy data from one worksheet and put it to the other right worksheets

I would like to copy cell E10 from a worksheet called "Overview" and paste it to cell D1 in all of the other Worksheets to the right of the "Overview" worksheet. Below is the code I have come up with. My issue is that this code executes for all worksheets, including the ones to the left of "Overview". Is there a way to have the code recognize to start to the right of "Overview"?
Sub Newthing()
Dim i As Integer
For i = 1 To ActiveWorkbook.Worksheets.Count
Worksheets("Overview").Range("E10").Copy
Worksheets(i).Range("D1").PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Thank you.
Copy to Next Worksheets
Option Explicit
Sub Newthing()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Overview")
' Get the next (first) and last worksheet indices.
Dim wsLast As Long: wsLast = wb.Worksheets.Count ' last worksheet index
Dim wsNext As Long: wsNext = ws.Index + 1 ' next worksheet index
' Prevent error if 'ws' is the last worksheet.
If wsNext > wsLast Then
MsgBox "'" & ws.Name & "' is the last worksheet.", vbCritical
Exit Sub
End If
' Write the value to a variable instead of reading it multiple times
' from the worksheet.
Dim cValue As Variant: cValue = ws.Range("E10").Value
Dim i As Long
' Copy by assignment (only values):
For i = wsNext To wsLast
wb.Worksheets(i).Range("D1").Value = cValue
Next i
End Sub

Setting worksheets dynamically in VBA

I have 66 sheets in my document (Sheet1, Sheet2, Sheet3, ...) and I'm trying to access all of them with the following code:
Dim currentSheet As Worksheet
For i = 1 To 66
Set currentSheet = "Sheet" & Cstr(i)
Next i
However, I get the "type mismatch" error. It seems I cannot set a worksheet using a string. How can I make this work?
I would rather say you do it this way:
Sub LoopThroughWorksheets()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsTarget As Worksheet
'You can set the workbook in which the sheets are there here, if not the current workbook
Set wb = ThisWorkbook
'Loop through each sheet in the current workbook
For Each ws In wb.Sheets
'Set the current ws as the target worksheet
Set wsTarget = ws
'You can then pass this wsTarget worksheet object to other function/sub
'Next worksheet
Next ws
End Sub
Another alternate way:
Sub LoopThroughWorksheetsMethod2()
Dim wb As Workbook
Dim intWs As Integer
Dim wsTarget As Worksheet
'You can set the workbook in which the sheets are there here, if not the current workbook
Set wb = ThisWorkbook
'Loop through all the sheets in the current workbook
For intWs = 1 To wb.Sheets.Count
'Set the current ws as the target worksheet
Set wsTarget = wb.Sheets(intWs)
'You can then pass this wsTarget worksheet object to other function/sub
'Next worksheet count
Next intWs
End Sub
By this you'll be creating a dynamic solution, in case your worksheet count changes in future.
You can retrieve the worksheet as a dynamic array.
Sub test()
Dim vWs() As Worksheet
Dim Ws As Worksheet
Dim n As Integer
For Each Ws In Worksheets
n = n + 1
ReDim Preserve vWs(1 To n)
Set vWs(n) = Ws
Debug.Print vWs(n).Name
Next Ws
End Sub
You can access the worksheet via the Workbook's worksheets collection.
Dim currentSheet As Worksheet
For i = 1 To 66
Set currentSheet = ThisWorkbook.Worksheets("Sheet" i)
'// do stuff with currentSheet...
Next i
Important things here are that this assumes your sheets bear the default names "Sheet" followed by a sequential number. If the loop arrives at "Sheet 33" and it doesn't exist, you will get an error.
If you want to cycle through ALL sheets, you could do it more safely like this:
Dim currentSheet As Worksheet
Dim wsName as String
For Each currentSheet in ThisWorkbook.Worksheets
'// do stuff with currentSheet... for example...
wsName = currentSheet.Name
Next i

Calling active VBA script from another workbook

I can run this VBA script from the current workbook, but I want to run from another new workbook and get the result on it.
Sub ListAllSheets()
Dim ws As Worksheet
Dim Counter As Integer
Counter = 0
For Each ws In ActiveWorkbook.Worksheets
ActiveCell.Offset(Counter, 0).Value = ws.Name
Counter = Counter + 1
Next ws
End Sub
It depends a bit on if the workbook is open already, and ActiveCell works only when the sheet is Active so if you HAVE TO use ActiveCell
Sub ListAllSheets()
Dim wb As Workbook
Set wb = Workbooks("Transactions")
Dim ws As Worksheet
Dim Counter As Integer
Counter = 0
For Each ws In wb.Worksheets
ws.Activate
Application.ActiveCell.Offset(Counter, 0).Value = ws.Name
Counter = Counter + 1
Next ws
End Sub
This may not do exactly what you want, as neither your question nor your code example were very clear (to me). Try to find another way that does not use ActiveCell at all for better results. Maybe something like this:
Sub ListAllSheets()
Dim wb1 As Workbook
Set wb1 = Workbooks("Transactions")
Dim ws1 As Worksheet
Dim wb2 As Workbook
Set wb2 = Workbooks("OtherWorkbook")
Dim ws2 as Worksheet
Set ws2 = wb2.Worksheets("Sheet1")
Dim Counter As Integer
Counter = 1
For Each ws1 In wb1.Worksheets
ws2.Cells(Counter, 1).Value = ws1.Name
Counter = Counter + 1
Next
End Sub
A more reliable way to set a Workbook object is to grab when you open it:
Set wb1 = Workbooks.Open("C:\Transactions.xlsx")

how to copy data from one sheet to another in different workbooks by sheet name using loops

i want to copy data from worksheets in workbook "Miz" to worksheets in workbook "Prime" by the worksheets names. meaning, i want the data from worksheet "assets" in Miz to be copied to worksheet "assets" in workbook "Prime" by loop (cause i have many worksheets) and so on for other worksheets.
p.s
i got the code to work but it doesn't loop through all the sheets. it only copies the first one and that's it.
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim WsSource As Workbook
Dim WsTarget As Workbook
Dim LastCell As Variant
Set WsSource = Workbooks("Prime.xlsm")
Set WsTarget = Workbooks("Miz.xlsm")
WsTarget.activate
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
If ActiveWorkbook.Worksheets(I).Name = WsSource.Worksheets(I).Name Then
WsTarget.activate
LastCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address
ActiveSheet.Range("A1", LastCell).Select
Selection.Copy
WsSource.activate
ActiveWorkbook.Worksheets(I).activate
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteAll
End If
Next I
End Sub
This could be done better, but i'm tired. The code loops through each workbook and copies the used range of the source workbook to the destination workbook range F1. Both workbooks must be open, or else you will receive the Subscript out of range error.
Sub WsLoop()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim WsSource As Workbook
Dim WsTarget As Workbook
Dim Rng As Range
Set WsSource = Workbooks("Miz.xlsm")
Set WsTarget = Workbooks("Prime.xlsm")
For Each ws In WsSource.Sheets
Set Rng = ws.UsedRange
For Each ws1 In WsTarget.Sheets
If ws.Name = ws1.Name Then
Rng.Copy Destination:=ws1.Range("F1")
End If
Next ws1
Next ws
End Sub

how can i use loop to lock the cell range through all the existing worksheet

I have a exist workbook which has more than 50 worksheet. i need to lock the cell range (b7:b51) for each of the exist worksheet. i try to use loop to do it and i have a code for loop which does go through all the worksheet, i need put the correct code to lock the cell.
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 2 To WS_Count
ActiveSheet.range("B1:B51").locked=true. --this is not correct.
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
thank
Try this...
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
If Worksheets(I).Range("C1:C51").Locked <> True Then
Worksheets(I).Range("C1:C51").Locked = True
Worksheets(I).Protect Contents:=True
Else
End If
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
This should do it.
Sub Macro1()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 2 To WS_Count
Dim sheet As Worksheet
Set sheet = Sheets(I)
sheet.Unprotect
sheet.UsedRange.Locked = False
sheet.Range("B7:B51").Locked = True
sheet.Protect Contents:=True
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
Public Sub ProtectRange()
Dim i As Integer, wsCount As Integer
wsCount = ActiveWorkbook.Worksheets.Count
For i = 1 To wsCount
ActiveWorkbook.Worksheets(i).Range("B1:B51").Locked = True
ActiveWorkbook.Worksheets(i).Protect Contents:=True
Next i
End Sub

Resources