VBA Macro Loop Through worksheet

[LearnVBA83]

Is there a way to write a macro that will loop through each worksheet in workbook and copy the name of the worksheet into that worksheet in cell A1 to A200?

 

[skillilea]

try this

Sub CopySheetNames()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A1:A200").Value = ws.Name
    Next
End Sub

 

[LearnVBA83]

try this

Sub CopySheetNames()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A1:A200").Value = ws.Name
    Next
End Sub

Shut the front door! Are you serious? Wow you guys have super powers! Thank you!

 

[skillilea]

Glad to help

 

[LearnVBA83]

try this

Sub CopySheetNames()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A1:A200").Value = ws.Name
    Next
End Sub

Now can i challenge you one more time? How can i make this macro only loop through the worksheets that have a 6 digit number in the name and do this same copy paste. Also some of the 6 digit numbers have leading zeros like 000826 so i'd want to capture all 6 of those in the copy paste! Is that possible?

 

[skillilea]

test it please

Sub CopySheetNamesWith6DigitNumbers()
    Dim ws As Worksheet
    Dim nameParts() As String
    Dim i As Integer
    Dim numericPart As String
    
    For Each ws In ThisWorkbook.Worksheets
        nameParts = Split(ws.Name, "0123456789")
        
        For i = 0 To UBound(nameParts)
            If IsNumeric(nameParts(i)) And Len(nameParts(i)) = 6 Then
                ws.Range("A1:A200").Value = ws.Name
                Exit For
            End If
        Next i
    Next ws
End Sub

 

[LearnVBA83]

Wow you're awesome! That is super close. The only thing i noticed were the ones with leading 0's like 008169 it only pasted 8169 and i need 008169. Also, it skipped the ones like 296135 - GSO Ramp. I need it to pick any up that have a 6 digit number and only paste the 6 digit number. I'm not 100% but I think the 6 digit number would always be first in the name.

 

[skillilea]

This is checking to make sure the number part is exactly six digits

test it

Sub CopySheetNamesWith6DigitNumbers()
    Dim ws As Worksheet
    Dim regex As Object
    Dim match As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\b\d{6}\b"
    
    For Each ws In ThisWorkbook.Worksheets
        If regex.Test(ws.Name) Then
            ws.Range("A1:A200").Value = ws.Name
        ElseIf Len(ws.Name) = 6 And IsNumeric(ws.Name) Then
            ws.Range("A1:A200").Value = ws.Name
        End If
    Next
End Sub

 

[LearnVBA83]

That code picked up the worksheet that had six digit number and words, but i pasted the whole name and not just the six digits. Also the worksheet with leading zeros still didn't pick up the zeros. It's close to being there thought! This is amazing.

 

[skillilea]

The 000000 sheet you will have to make the column TEXT to see them all.

try this, slight change

Sub CopySheetNamesWith6DigitNumbers()
    Dim ws As Worksheet
    Dim regex As Object
    Dim match As Object
    Dim extractedNumber As String
    
    Set regex = CreateObject("VBScript.RegExp")
    
    regex.Pattern = "\d{6}"
    
    For Each ws In ThisWorkbook.Worksheets
        If regex.Test(ws.Name) Then
            Set match = regex.Execute(ws.Name)
            If Not match Is Nothing Then
                extractedNumber = match(0)
                If Len(extractedNumber) = 6 Then
                    ws.Range("A1:A200").Value = extractedNumber
                End If
            End If
        End If
    Next
End Sub