Copy sheet name down entire column with loop

[rachel06]

Hi!

This one has been my struggle for a few days now. I have a macro that brings in several sheets from different workbooks (which are batches of clients) and names them after the original workbook. Basically, I have a workbook with worksheets of accrual amounts and the worksheets are named after the batch.

Anyway, I'm trying to add a column with the batch name (worksheet name) and copy it all the way down column J. This seems redundant, but I eventually paste all the batches together, and need this information to pivot.


Below is what I have so far. (The one that's got the ' by it is also something I've been playing with). This brings the sheet name into J2, but nothing I'm trying will copy it all the way down. Any suggestions on how I can add to the below to accomplish this?

Sub JobID()
Dim wsDashboard As Worksheet, ws As Worksheet

Set wsDashboard = Worksheets("Dashboard")

With wsDashboard
.Range("D1").Value = "JobID"

For Each ws In Worksheets
If Not ws Is wsDashboard Then
ws.Range("I1").Copy
ws.Range("J1").PasteSpecial xlPasteFormats
ws.Range("J1").Value = "JobID"
ws.Range("J2").Value = ws.Name
'ws.Cells(.Rows.Count, 10).End(xlUp).Offset(1, 0).Value = ws.Name
ws.Range("J2").Copy


End If
Next

.Columns(10).AutoFit
End With
End Sub

Thanks!
Rachel

 

[Norie]

Rachel

How does the code not work?

 

[rachel06]

Hi Norie!

It's currently only inserting the sheet name into J2 (which is how it's written currently). I can't figure out how to get it to insert the sheet name into all the rows in column J where there is data in A-I. This code works as written, I just need it to do a bit more. Nothing I've tried adding to this has accomplished adding the sheet name in all rows. I didn't include the things I've tried that have failed because I'm assuming those are just way off.

Thanks,
Rachel

 

[mumps]

Try:

Sub JobID()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, bottomA As Long, bottomJ As Long
    Sheets("Dashboard").Range("D1") = "JobID"
    For Each ws In Worksheets
        If ws.Name <> "Dashboard" Then
            With ws
                bottomA = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("I1").Copy
                .Range("J1").PasteSpecial xlPasteFormats
                .Range("J1") = "JobID"
                bottomJ = .Range("J" & .Rows.Count).End(xlUp).Row + 1
                .Range("J" & bottomJ & ":J" & bottomA).Value = ws.Name
                .Columns(10).AutoFit
            End With
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[rachel06]

Try:

Sub JobID()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, bottomA As Long, bottomJ As Long
    Sheets("Dashboard").Range("D1") = "JobID"
    For Each ws In Worksheets
        If ws.Name <> "Dashboard" Then
            With ws
                bottomA = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("I1").Copy
                .Range("J1").PasteSpecial xlPasteFormats
                .Range("J1") = "JobID"
                bottomJ = .Range("J" & .Rows.Count).End(xlUp).Row + 1
                .Range("J" & bottomJ & ":J" & bottomA).Value = ws.Name
                .Columns(10).AutoFit
            End With
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

THANK YOU!!!!! This is perfect!!!

 

[mumps]

You are very welcome.