Running code for three sets of worksheets

Cross posted here with a solution: http://www.excelforum.com/excel-prog...st-column.html

I was mistaken in reply #2 - sorry.

ag123,

With your latest attached workbook containing the following three worksheets, and, no formulae as per your other thread:
M) Avg Hrs- Month
N) Avg Hrs- Month
A) Avg Hrs- Month


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReorgDataForThree()
' stanleydgromjr, 07/15/2013
' http://www.excelforum.com/excel-programming-vba-macros/938902-copy-column-and-paste-to-end-of-first-column.html
Dim r As Long, lr As Long, nlr As Long, c As Long, lc As Long, nlc As Long
Dim a As Variant, b As Variant
Dim i As Long, ii As Long
Application.ScreenUpdating = False
With Sheets("M) Avg Hrs- Month")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
  For r = 1 To lr Step 1
    If .Cells(r, 1).Value = "" Then nlr = r - 1
  Next r
  For c = 1 To lc Step 1
    If .Cells(1, c).Value = "" Then nlc = c - 1
  Next c
  a = .Range(.Cells(1, 1), .Cells(nlr, nlc)).Value
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
  For c = 4 To UBound(a, 2)
    For i = 2 To UBound(a, 1)
      If a(i, 1) <> "" Then
        ii = ii + 1
        b(ii, 1) = a(i, 1)
        b(ii, 2) = a(i, 2)
        b(ii, 3) = a(i, 3)
        b(ii, 4) = a(1, c)
        b(ii, 5) = a(i, c)
      End If
    Next i
  Next c
End With
If Not Evaluate("ISREF('M) Data for PT'!A1)") Then Worksheets.Add(After:=Sheets("M) Avg Hrs- Month")).Name = "M) Data for PT"
With Sheets("M) Data for PT")
  .UsedRange.ClearContents
  With .Cells(1, 1).Resize(, 5)
    .Value = [{"Resource Name","Team","Department","Month","Hours"}]
    .Font.Bold = True
  End With
  .Cells(2, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("E2:E" & lr).NumberFormat = "#,##0.00"
  .Columns.AutoFit
End With
Erase a: Erase b
i = 0: ii = 0
With Sheets("N) Avg Hrs- Month")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
  For r = 1 To lr Step 1
    If .Cells(r, 1).Value = "" Then nlr = r - 1
  Next r
  For c = 1 To lc Step 1
    If .Cells(1, c).Value = "" Then nlc = c - 1
  Next c
  a = .Range(.Cells(1, 1), .Cells(nlr, nlc)).Value
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
  For c = 4 To UBound(a, 2)
    For i = 2 To UBound(a, 1)
      If a(i, 1) <> "" Then
        ii = ii + 1
        b(ii, 1) = a(i, 1)
        b(ii, 2) = a(i, 2)
        b(ii, 3) = a(i, 3)
        b(ii, 4) = a(1, c)
        b(ii, 5) = a(i, c)
      End If
    Next i
  Next c
End With
If Not Evaluate("ISREF('N) Data for PT'!A1)") Then Worksheets.Add(After:=Sheets("N) Avg Hrs- Month")).Name = "N) Data for PT"
With Sheets("N) Data for PT")
  .UsedRange.ClearContents
  With .Cells(1, 1).Resize(, 5)
    .Value = [{"Resource Name","Team","Department","Month","Hours"}]
    .Font.Bold = True
  End With
  .Cells(2, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("E2:E" & lr).NumberFormat = "#,##0.00"
  .Columns.AutoFit
End With
Erase a: Erase b
i = 0: ii = 0
With Sheets("A) Avg Hrs- Month")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
  For r = 1 To lr Step 1
    If .Cells(r, 1).Value = "" Then nlr = r - 1
  Next r
  For c = 1 To lc Step 1
    If .Cells(1, c).Value = "" Then nlc = c - 1
  Next c
  a = .Range(.Cells(1, 1), .Cells(nlr, nlc)).Value
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
  For c = 4 To UBound(a, 2)
    For i = 2 To UBound(a, 1)
      If a(i, 1) <> "" Then
        ii = ii + 1
        b(ii, 1) = a(i, 1)
        b(ii, 2) = a(i, 2)
        b(ii, 3) = a(i, 3)
        b(ii, 4) = a(1, c)
        b(ii, 5) = a(i, c)
      End If
    Next i
  Next c
End With
If Not Evaluate("ISREF('A) Data for PT'!A1)") Then Worksheets.Add(After:=Sheets("A) Avg Hrs- Month")).Name = "A) Data for PT"
With Sheets("A) Data for PT")
  .UsedRange.ClearContents
  With .Cells(1, 1).Resize(, 5)
    .Value = [{"Resource Name","Team","Department","Month","Hours"}]
    .Font.Bold = True
  End With
  .Cells(2, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("E2:E" & lr).NumberFormat = "#,##0.00"
  .Columns.AutoFit
End With
Sheets(2).Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgDataForThree macro.

ag123,

Thanks for the feedback.

You are very welcome. Glad I could help.

Come back anytime.