Excel 2007 I need help getting a macro to draw from a range with multiple column

Question

Excel 2007 I need help getting a macro to draw from a range with multiple columns

Hi, I am trying to edit a macro in Excel 2007 that copies a range and pastes it into a new range on the same sheet. However, the source range is 5 columns wide and I would like the destination range to be a single column that lists them all in order. I am using a macro that was originally set up to do the same thing but drawing only from a single column. Is this possible? I have pasted the code currently have below. Any help would be greatly appreciated! Thank you!

Sub GoalsButton()
'
' Macro21 Macro
'
Application.ScreenUpdating = False
Sheets("Goals Sheet").Select
Range("D3:H30").Select
Selection.Copy
Sheets("Goals Sheet").Select
Range("M:M").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.Delete Shift:=xlUp
Columns("M:M").Select
Columns("M:M").EntireColumn.AutoFit
Columns("M:M").Select
ActiveSheet.Range("M:M").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("M2:M175").Select
ActiveWorkbook.Worksheets("Goals Sheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Goals Sheet").Sort.SortFields.Add Key:=Range("M:M"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Goals Sheet").Sort
.SetRange Range("M2:M175")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
  
End Sub

Explanation / Answer

FDoes this do what you want?
>>>>>>>>>>>>>>

Sub GoalsButton()
Dim x As Long, y As Long
Dim ws As Worksheet, Lastrow As Long
Set ws = Sheets("Goals Sheet")
y = 3
Application.ScreenUpdating = False
For x = 4 To 8
    ws.Cells(3, x).Resize(28).Copy
    ws.Cells(y, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
    y = y + 28
Next
Lastrow = Cells(Cells.Rows.Count, "M").End(xlUp).Row
     Range("M3:M" & Lastrow).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
   
     Columns("M:M").EntireColumn.AutoFit
  
      Range("M3:M" & Lastrow).RemoveDuplicates Columns:=1, Header:=xlNo
     'Alphabetize
Lastrow = Cells(Cells.Rows.Count, "M").End(xlUp).Row
     ActiveWorkbook.Worksheets("Goals Sheet").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("Goals Sheet").Sort.SortFields.Add Key:=Range("M:M"), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With ActiveWorkbook.Worksheets("Goals Sheet").Sort
         .SetRange Range("M3:M" & Lastrow)
         .Header = xlNo
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
   
End Sub

Related Questions

Navigate

• Browse (All)
• Browse E
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.