Copy column and paste to end of first column

hi ag123, welcome to Excelforum, option, please check attachment, press "Run" button or run code "test"

Wow! Thank you both so much, it's almost perfect!

I adapted stanleydgromjr's code to fill an existing sheet instead of creating a new one.

Two things, if possible...
1. I would prefer if the values under "feb" were placed directly under "jan" without multiple blank rows beneath them (even though the number of names will vary each time the code is run).

2. I would prefer is the loop stopped after the last filled column (in the test case: "feb"). right now there are multiple rows beneath the data that have the the first 3 columns filled (i.e. name/ dept/ team) but no month or value because those are blank. Can we make it end after the last month that is present?

Thank you SOOO So much already, it's a big helpa nd I can't wait to get this perfect


My code so far is:

Option Explicit
Sub ReorgData()
' stanleydgromjr, 07/13/2013
' http://www.excelforum.com/excel-programming-vba-macros/938902-copy-column-and-paste-to-end-of-first-column.html
Dim a As Variant, b As Variant
Dim c As Long, i As Long, ii As Long
With Sheets("M) Avg Hrs- Month")
  a = .Cells(1).CurrentRegion
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
End With
For c = 4 To UBound(a, 2)
  For i = 2 To UBound(a, 1)
    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)
  Next i
Next c
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
  .Columns.AutoFit
  .Activate
End With
End Sub

stanleydgromjr,

Thanks for your quick reply. This is happening because the worksheet is filled with formulas to row 500 and column BZ that evaluate to "" if data from another worksheet is empty. So what I need to do is select all the cells that contain a value that is NOT "" (blank) and then do the function that you had posted above. How can I select only those cells to apply the above code to?

Thanks again

Unfortunately, I cannot post the real workbook due to proprietary info, but I recreated a small data set of what my problem looks like.
Basically on Sheet: "M) Avg Hrs- Month it takes data from sheet: "M) Total Hrs- Month" and divides it by a specified number if the cell contains anything. the extra "" cells on M) Avg Hrs- Month Run through row 20 and column z i believe.


THANKS!!!

what i want to do.xlsm

I know this is ugly, but bear with me as I am MORE than a novice at vba...

This is how I am selecting the range and then applying the loop. My only problem right now is that I need to do this for three different sets of worksheets and I cannot with the current code because the variable names are duplicated for each of the three (the three sections can be found with 'for mat/ 'for arg/ 'for nap and all the code below that section). How can I make the code run through the 3 sets of worksheets without having to go through and change all the variable names?


THANKS AGAIN!!

Option Explicit
Sub ReorgData()

With Excel.Application
        .ScreenUpdating = False
        .Calculation = Excel.xlManual
        .EnableEvents = False
End With

' for Mat

'find active range
Sheets("M) Avg Hrs- Month").Select
Columns("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(-1, 0).Select
    Cells.FindNext(After:=ActiveCell).Activate
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy

Dim a As Variant, b As Variant
Dim c As Long, i As Long, ii As Long
With Sheets("M) Avg Hrs- Month")
  a = Selection
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
End With
For c = 4 To UBound(a, 2)
  For i = 2 To UBound(a, 1)
    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)
  Next i
Next c
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
  .Columns.AutoFit
  .Activate
End With

'delete extra
Sheets("M) Data for PT").Select
Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.Delete
    Range("A1").Select

    
'Paste Values
Sheets("M) Data for PT").Select
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Columns("E:E").Select
    Selection.NumberFormat = "0.0"
    Range("A1").Select
    ActiveWorkbook.Save
    
    
    
    
    
' for Arg

'find active range
Sheets("A) Avg Hrs- Month").Select
Columns("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(-1, 0).Select
    Cells.FindNext(After:=ActiveCell).Activate
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy

Dim a As Variant, b As Variant
Dim c As Long, i As Long, ii As Long
With Sheets("M) Avg Hrs- Month")
  a = Selection
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
End With
For c = 4 To UBound(a, 2)
  For i = 2 To UBound(a, 1)
    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)
  Next i
Next c
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
  .Columns.AutoFit
  .Activate
End With

'delete extra
Sheets("A) Data for PT").Select
Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.Delete
    Range("A1").Select

    
'Paste Values
Sheets("A) Data for PT").Select
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Columns("E:E").Select
    Selection.NumberFormat = "0.0"
    Range("A1").Select
    ActiveWorkbook.Save
    
    
    
    
    
    
' for Nap

'find active range
Sheets("N) Avg Hrs- Month").Select
Columns("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(-1, 0).Select
    Cells.FindNext(After:=ActiveCell).Activate
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy

Dim a As Variant, b As Variant
Dim c As Long, i As Long, ii As Long
With Sheets("N) Avg Hrs- Month")
  a = Selection
  ReDim b(1 To (UBound(a, 1) * (UBound(a, 2) - 3)), 1 To 5)
End With
For c = 4 To UBound(a, 2)
  For i = 2 To UBound(a, 1)
    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)
  Next i
Next c
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
  .Columns.AutoFit
  .Activate
End With

'delete extra
Sheets("N) Data for PT").Select
Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.Delete
    Range("A1").Select

    
'Paste Values
Sheets("N) Data for PT").Select
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Columns("E:E").Select
    Selection.NumberFormat = "0.0"
    Range("A1").Select
    ActiveWorkbook.Save

With Excel.Application
    .ScreenUpdating = True
    .Calculation = Excel.xlAutomatic
    .EnableEvents = True
End With
    
End Sub

This question might be better solved in another thread. Please refer to:

http://www.excelforum.com/excel-prog...80#post3322280


Thank for your help

Standgromjr,

I posted a solution that I came up with in #9, your solution from #10 works as well, but it doesn't help me to repeat the process through ALL 3 sets of data (This part of my question was posted in #9 just minutes before you posted your solution in #10. I stated:: My only problem right now is that I need to do this for three different sets of worksheets and I cannot with the current code because the variable names are duplicated for each of the three (the three sections can be found with 'for mat/ 'for arg/ 'for nap and all the code below that section). How can I make the code run through the 3 sets of worksheets without having to go through and change all the variable names?

I started a new thread because it is somewhat of a different question, but I guess I was wrong. Can you help with this as well??

THANKS