Change code to dynamic range

[hanz753]

Hello,

I have this code and I would like it to stop at the last row of the data in each sheet.

Option Explicit
Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

ActiveSheet.[d1:d33] = ActiveSheet.Name



On Error Resume Next
ws.Range("d2:d33") = ws.Name



Next ws
End Sub

Can this be done?

Kind Regards

 

[footoo]

Re: How to change code to dynamic range

Sub LoopThroughSheets()
Dim ws As Worksheet, lr&
ActiveSheet.[D1] = ActiveSheet.Name
For Each ws In ActiveWorkbook.Worksheets
    lr = ws.Cells.Find(What:="*", After:=ws.[A1], _
        searchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ws.Range(ws.[D2], ws.Cells(lr, "D")) = ws.Name
Next
End Sub

 

[hanz753]

Re: How to change code to dynamic range

That's nearly perfect thank you.

But, what it does on the first sheet I need it to apply to all sheets starting from cell D1.

Thank you for your help

 

[footoo]

Re: How to change code to dynamic range

Sub LoopThroughSheets()
Dim ws As Worksheet, lr&
For Each ws In ActiveWorkbook.Worksheets
    lr = ws.Cells.Find(What:="*", After:=ws.[A1], _
        searchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ws.Range(ws.[D1], ws.Cells(lr, "D")) = ws.Name
Next
End Sub

 

[hanz753]

Re: How to change code to dynamic range

That's Perfect, thank you for your time.

 

[hanz753]

Re: How to change code to dynamic range

Hi,

How would you apply this code 2 rows above the bottom of the data?

 

[footoo]

Re: How to change code to dynamic range

Sub LoopThroughSheets()
Dim ws As Worksheet, lr&
For Each ws In ActiveWorkbook.Worksheets
    lr = ws.Cells.Find(What:="*", After:=ws.[A1], _
        searchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [COLOR=#ff0000]- 2[/COLOR]
    ws.Range(ws.[D1], ws.Cells(lr, "D")) = ws.Name
Next
End Sub