I want to filter workbook by looking for all blank entries in column E. Then copy range into another workbook at the next available row. When I run my code I get an error 'run time error' 1004 - PasteSpecial method of range class failed?? How would I debug this to be able to copy my range and paste into other workbook?
I have only just started learning VBA and learned most of what I know from google and watching youtube videos. I have tried to change the value for blank "", I have tried to add application.cutcopymode false
Sub MoveUnworkedtoDB()
`Dim wbk As Workbook
Dim sh As Worksheet
Dim Lastrow As Long
' Open worksheet 1 and move unworked back to database
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbk = Workbooks.Open(Filename:= _
"Workbook1")
Set sh = wbk.Sheets("sheet1")
'Clear any existing filters
On Error Resume Next
sh.ShowAllData
On Error GoTo 0
'Apply Filter
sh.Range("A1:E9").AutoFilter Field:=5, Criteria1:=""
'copy Range
Application.DisplayAlerts = False
sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
Application.DisplayAlerts = True
'Clear Filter
On Error Resume Next
sh.ShowAllData
On Error GoTo 0
Set wbk = Workbooks.Open(Filename:= _
"workbook2")
Set sh = wbk.Sheets("sheet1")
Lastrow = Range("A65536").End(xlUp).row
Sheets("sheet1").Activate
Cells(Lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub`
runtime error 1004 - pastespecial method of range class failed
Depends on Excel version. You can't do this in Excel 2003 and older. You transpose 1000 rows to 1000 columns, old Excels have 256 columns only.
I corrected a bit Your code, now will work in newest versions, from 2007 up.
Sub MoveUnworkedtoDB()
Dim wbk As Workbook
Dim sh As Worksheet
Dim Lastrow As Long
Dim wbk2 As Workbook
Dim sh2 As Worksheet
' Open worksheet 1 and move unworked back to database
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbk = Workbooks.Open(Filename:="C:\temp\A.xlsx")
Set sh = wbk.Sheets(1)
'Clear any existing filters
On Error Resume Next
sh.ShowAllData
On Error GoTo 0
'Apply Filter
sh.Range("A1:E9").AutoFilter Field:=5, Criteria1:=""
'copy Range
Application.DisplayAlerts = False
'sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
Application.DisplayAlerts = True
'Clear Filter
On Error Resume Next
sh.ShowAllData
On Error GoTo 0
Set wbk2 = Workbooks.Open(Filename:="C:\temp\B.xlsx")
Set sh2 = wbk2.Sheets(1)
With sh2
Lastrow = .Range("A65536").End(xlUp).Row
sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
.Cells(Lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
Trying to get a macro that prompts a user to open an xlsm file, go to a specific tab, unhide the columns and turn off the filters, select all the data and paste into a new tab called RRImport.
Example: Working in a file called MergedData.xlsm, run macro to Open Jul01Data.xlsm, select "Reviewed Data" tab in Jul01Data.xlsm, unhide all columns and turn off all filters in the "Reviewed Data" tab, copy all data, Make a New sheet in MergedData.xlsm called "RRImport" and paste-special-values all the data in cell A1 of "RRImport". Close Jul01Data.xlsm without saving any changes to it
Sub ImportSheet()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "RRImport"
Sheets("RRImport").Select
Application.DisplayAlerts = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Append to Merged Data", _
FileFilter:="Report Files *.xlsm (*.xlsm),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
End If
wb2.Sheets("Reviewed Data").Select
' HERE IS WHERE I GET THE ERROR, IR WON'T UNHIDE THE FILTERS
If wb2.AutoFilterMode Then
wb2.AutoFilterMode = False
End If
Columns("A:M").Select
Selection.Copy
wb1.Sheets("RRImport").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb2.Close
End Sub
It should work Now:
AutoFilterMode is a Worksheet Property not Workbook Property.
Sub ImportSheet()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Append to Merged Data", _
FileFilter:="Report Files *.xlsm (*.xlsm),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(filename:=FileToOpen)
End If
If wb2.Sheets("Reviewed Data").AutoFilterMode Then
wb2.Sheets("Reviewed Data").AutoFilterMode = False
End If
Dim ws As Worksheet
wb1.Activate
Set ws = wb1.Worksheets.Add(, ActiveSheet)
ws.Name = "RRImport"
wb2.Sheets("Reviewed Data").Columns("A:M").Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb2.Close False
End Sub
I have made few other changes also.
So as this worked, I'll add the explanation.
First, you selected the worksheet, but then your code goes on while you're referring to the whole workbook, and not the worksheet.
That means, you don't need to select the worksheet, just refer to it same as you referred to the workbook.
What if instead
wb2.Sheets("Reviewed Data").Select
' HERE IS WHERE I GET THE ERROR, IR WON'T UNHIDE THE FILTERS
If wb2.AutoFilterMode Then
wb2.AutoFilterMode = False
End If
You wrote
If wb2.Sheets("Reviewed Data").AutoFilterMode Then
wb2.Sheets("Reviewed Data").AutoFilterMode = False
End If
I have 5 worksheets in my workbook(Table 1, Table 2, Table 3, Table 4 and Combined). The main Worksheet is the one I am trying to combine the other 4 into and place the data on the next blank line.
I have been googling different code solutions for weeks to no avail.
When I step through the macro and use the loop (do while, for and Each), it is only looping through Table 1 perfectly. But I cannot get it to loop through Sheets 2-4.
I think I know where my issue is, but in my weeks of googling, I still can't find the solution. I think the issue is on the line where it reads "Sheets("Table 1").Select". Because the code seems to work till it gets to that line. Then it "of course" goes back to Table 1.
This is a test group for a much larger project. I have to pull information from 500 documents that are all set up in the exact same position, but I have to get these 4 to work first.
'I have tried this:
Dim iSheet As Object
For Each iSheet In ThisWorkbook.Sheets
MsgBox iSheet.Name
Next iSheet
'And I tried this:
Dim useWorkSheet As Worksheet
Dim totalWorkSheet As Worksheet
Dim tableAsNumeric As Integer
Dim startingTable As Integer
'For Each Current In Worksheets
'Table Name = Table in Worksheets
startingTable = 1
Set totalWorkSheet = ActiveWorkbook.Sheets("Table 1")
For Each useWorkSheet In ActiveWorkbook.Worksheets
tableAsNumeric = Val(useWorkSheet.Name)
'If tableAsNumeric >= startingTable Then
'Do While I >= Worksheet("Table 1")
'I = I + 1
'I have also tried a for loop and as many others as there are out on the net... Nothing works...
This is the code I need help with:
Sub TFRdataExtract()
'
' TFRdataExtract Macro
' Extract Data from Individual TFR files to the combined file.
'
' Keyboard Shortcut: Ctrl+e
'
Dim iSheet As Object
For Each iSheet In ThisWorkbook.Sheets
MsgBox iSheet.Name
Sheets("Table 1").Select
Range("AB1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-27], 7,100)"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-24], 14,100)"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-19],23,100)"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-10],22,100)"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-16], 10,100)"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-13],13,100)"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-34],22,100)"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-25],18,100)"
Range("AK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-16],21,100)"
Range("AL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-37],21,100)"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-28],17, 100)"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-21],34,100)"
Range("AO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-40],28,100)"
Range("AP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-35], 7,100)"
Range("AQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-34],10,100)"
Range("AR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-29],10,100)"
Range("AS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-21],22,100)"
Range("AT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[5]C[-45],26,100)"
Range("AU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[6]C[-46],18,100)"
Range("AV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[6]C[-37],55,100)"
Range("AW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-48],36,100)"
Range("AX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-39],30,100)"
Range("AY1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-28],12,100)"
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-51],20,100)"
Range("BA1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-35],12,100)"
Range("BB1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-31],20,100)"
Range("BC1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-54],25,100)"
Range("BD1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-45],15,100)"
Range("BE1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-39],23,100)"
Range("BF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-57],17,100)"
Range("BG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-56],17,100)"
Range("BH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-52],13,100)"
Range("BI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-42],14,100)"
Range("BJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-38],15,100)"
Range("BK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],11,100)"
Range("BL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],12,100)"
Range("BM1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-59],10,100)"
Range("BN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-57], 7,100)"
Range("BO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],7,100)"
Range("BP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],11,100)"
Range("BQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-53],12,100)"
Range("BR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-50],8,100)"
Range("BS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-47],12,100)"
Range("BT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],10,100)"
Range("BU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],20,100)"
Range("BV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-66],10,100)"
Range("BW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-63],10,100)"
Range("BX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-62],8,100)"
Range("BY1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-61],7,100)"
Range("BZ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-59],9,100)"
Range("CA1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-57],10,100)"
Range("CB1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-55],13,100)"
Range("CC1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],12,100)"
Range("CD1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],13,100)"
Range("CE1").Select
ActiveCell.FormulaR1C1 = ""
Range("CE1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-77],15,100)"
Range("CF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-72],7,100)"
Range("CG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-71],13,100)"
Range("CH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-67],14,100)"
Range("CI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-62],7,100)"
Range("CJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-87],13,100)"
Range("CK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-85],15,100)"
Range("CL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-82],11,100)"
Range("CM1").Select
ActiveCell.FormulaR1C1 = "L16,11,100)"
Range("CN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-73],15,100)"
Range("CO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-68],8,100)"
Range("CP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[17]C[-93],19,100)"
Range("CQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[17]C[-80],22,100)"
Range("CR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[18]C[-95],27,100)"
Range("CS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[18]C[-82],18,100)"
Range("CT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-97],45,100)"
Range("CU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-89],22,100)"
Range("CV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-81],49,100)"
Range("CW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[20]C[-91],21,100)"
Range("CX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[21]C[-101],16,100)"
Range("CY1").Select
ActiveCell.FormulaR1C1 = "=MID(22,27,100)"
Range("CZ1").Select
ActiveWindow.SmallScroll Down:=-3
Range("CY1").Select
ActiveWindow.SmallScroll ToRight:=-50
Range("AB1:CY1").Select
Range("CY1").Activate
Selection.Copy
Sheets("Combined").Select
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next iSheet
End Sub
I need to loop through all 4 Worksheets and paste data onto the Combined file into the next blank line.
try this:
For sht = 1 To Sheets.Count
Debug.Print sht
'your code here
Sheets(sht).Activate'or
Sheets(Sheets(sht).Name).Activate
Next
Perhaps this will help. Commented to help understand what is going on.
'// Modify as desired, like to empty rows/columns.
Private Function GetRangeToCopy(zWorksheet As Worksheet) As Range
Set GetRangeToCopy= zWorksheet.UsedRange
End Function
'// Modify to add spacing or whatnot.
Private Function GetDestinationRange(zDestinationWorksheet As Worksheet, zRowCount As Long, zColumnCount As Long) As Range
Dim zReturnRange As Range
Dim zNewRowIndex As Long
Let zNewRowIndex = zDestinationWorksheet.UsedRange.End.Row + 3 '// Increase to add more rows between inserts.
Set zReturnRange = zDestinationWorksheet.
Set GetDestinationRange = zReturnRange
End Function
'// Copies a range to the destination range.
Private Sub CopyRange(zSourceRange As Range, zDestinationRange As Range)
'// This is where copying styles and such would be done.
'// We will just call copy for simplicity.
'// Clear.
Call zDestinationRange.Clear
'// Copy.
Call zSourceRange.Copy(zDestinationRange)
End Sub
'// Copy worksheets to a destination worksheet.
'// Destination worksheet can be a worksheet loaded into a different workbook altogether.
Public Sub CopyWorksheetsTo(zDestinationWorksheet As Worksheet, zClearDestinationWorksheet As Boolean = False _
zPopupCurrentWorksheet As Boolean = True)
Dim zCurrentWorksheet As Worksheet
Dim zCurrentWorksheet_Var As Variant
Dim zRangeToCopy As Range
Dim zDestinationRange As Range
'// Clear destination.
If (zClearDestinationWorksheet) Then
Call zDestinationWorksheet.UsedRange.Clear
End If
'// Cycle through each worksheet in the workbook.
ForEach zCurrentWorksheet_Var in Worksheets
'// this allow us the Intellisense while coding.
Set zCurrentWorksheet = zCurrentWorksheet_Var
'// Make sure this isn't the destination worksheet.
If (zCurrentWorksheet.Name <> zDestinationWorksheet.Name) Then
'// Popup worksheet name.
If (zPopupCurrentWorksheet) Then
Call MsgBox(zCurrentWorksheet.Name)
End If
'// Get range to be copied.
Set zRangeToCopy = GetRangeToCopy(zCurrentWorksheet)
'// Get destination range.
Set zDestinationRange = GetDestinationRange(zDestinationWorksheet)
'// Copy range.
Call CopyRange(zRangeToCopy, zDestinationRange)
End If
Next xCurrentWorksheet_Var
End Sub
To loop on all Worksheets
Example
Option Explicit
Public Sub Example()
' // Declare your Variables
Dim Sht As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
'// loop on all sheets
For Each Sht In Worksheets
Debug.Print Sht.Name
'Do something
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Try this code snippet. I am already using this in a macro.
Sub Combine()
' ensure you have placed the "combined" worksheet as the first sheet
'variable declaration
Dim J As Integer
'copying header row from second sheet
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A1")
'copying data from other sheets
For J = 2 To 4
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A65536")_
.End(xlUp) (2)
Next
ThisWorkbook.Worksheets("combined").Columns.AutoFit
End Sub
In my opinion you should try to avoid .Select. Try:
Option Explicit
Sub test()
Dim ws As Worksheet
With ThisWorkbook
For Each ws In .Worksheets
If ws.Name = "Table 1" Then
With ws
.Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)"
.Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
.Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
.Range("AE1").FormulaR1C1 = "=MID(RC[-10],22,100)"
.Range("AF1").FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
'....... Add more formulas
.Range("AB1:CY1").Copy
End With
With .Worksheets("Combined").Range("A2")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End If
Next ws
End With
End Sub
This should work:
Sub TFRdataExtract()
Dim iSheet As Worksheet, rngCopy As Range
For Each iSheet In ThisWorkbook.WorkSheets
If iSheet.Name Like "Table*" Then
With iSheet '<< no need to activate!
.Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)" '<< no need to select!
.Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
.Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
'etc etc
Set rngCopy = .Range("AB1:CY1")
End with
'assign values directly
With ThisWorkbook.Sheets("Combined").Range("A2")
.Resize(rngCopy.Rows.Count, _
rngCopy.Columns.Count).Value = rngCopy.Value
End with
End If 'EDIT - added
Next iSheet
End Sub
I have 35 to 40 worksheets with daily stock data and I am trying to calculate the stock returns for each worksheet in a macro. The formula is: LN(Today/Yesterday) which gives the daily stock return. I am running the code below but I cannot figure out how to start the loop in the 5th worksheet. My portfolio is in the first four worksheets. Anyone know how this would work?
Sub Macro2()
Dim wb As Workbook
Dim i As Integer
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Worksheets.Count = 5
For i = 5 To ThisWorkbook.Worksheets.Count
Activeworksheet.Columns("c").ClearContents
Range("C4").Select
ActiveCell.FormulaR1C1 = "=LN(RC[-1]/R[-1]C[-1])"
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C507")
Range("C4:C507").Select
Next i
End Sub
You should avoid using .Select as that's contributing to it I believe. This should help:
Sub Macro2()
Dim wb As Workbook
Dim i As Integer
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Worksheets.Count = 5
For i = 5 To ThisWorkbook.Worksheets.Count
With Worksheets(i)
.Columns("c").ClearContents
.Range("C4").FormulaR1C1 = "=LN(RC[-1]/R[-1]C[-1])"
.Range("C4").AutoFill Destination:=.Range("C4:C507")
Next i
End Sub
Note how you have the right idea, the For loop starting with i = 5 is good, but you then never actually use i. When you use ActiveSheet, it (obviously?) uses whatever the current sheet that's active is. Thus, your code was only going to run on that sheet...and it'd so so however many times you have worksheets (if that makes sense).
Figured it out guys. Heres code based on prices in B3:B and returns in C4:C
Sub Macro2()
Dim wb As Workbook
Dim i As Integer
Dim ws As Long
Set wb = ActiveWorkbook
For i = 6 To 56
ws = Worksheets(i).Activate
Range("C4").Select
ActiveCell.FormulaR1C1 = "=LN(RC[-1]/R[-1]C[-1])"
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C507")
Range("C4:C507").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "Daily Return"
Range("C:C").Select
Columns("C:C").EntireColumn.AutoFit
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B:B").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Style = "Currency"
Next i
End Sub