Macro to combine and sort column data

[guybrownbarnett]

Hi all

I wonder if anyone can help me create a macro.
Essentially, I'm looking to populate an empty column with alphabetically sorted combined data from 2 existing columns, then add data below from a third column.



For example:
Sheet2 ColumnA is cleared.
All populated cells in Sheet1 ColumnA are copied into Sheet2 ColumnA.
All populated cells in Sheet1 ColumnB are copied into Sheet2 ColumnA below any existing data.
Sheet2 ColumnA is sorted alphabetically.
All populated cells in Sheet1 ColumnC are copied into Sheet2 ColumnA below any existing data.

Any ideas much appreciated?

Regards,

Guy Brown

 

[SteveO59L]

Dim lastrow As Long
lastrow = Cells(Rows.Count, "a").End(xlUp).Row

Sheets("Sheet2").Select
Columns("A:A").ClearContents

Sheets("Sheet1").Select
Range("A1:a" & lastrow).Copy
Sheets("Sheet2").Select
Range("a1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
lastrow = Cells(Rows.Count, "b").End(xlUp).Row
Range("b1:b" & lastrow).Copy
Sheets("Sheet2").Select
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lastrow + 1).Select
ActiveSheet.Paste
lastrow = Cells(Rows.Count, "a").End(xlUp).Row

With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:A" & lastrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1").Select
lastrow = Cells(Rows.Count, "c").End(xlUp).Row
Range("c1:c" & lastrow).Copy
Sheets("Sheet2").Select
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lastrow + 1).Select
ActiveSheet.Paste

 

[guybrownbarnett]

Dim lastrow As Long
lastrow = Cells(Rows.Count, "a").End(xlUp).Row

Sheets("Sheet2").Select
Columns("A:A").ClearContents

Sheets("Sheet1").Select
Range("A1:a" & lastrow).Copy
Sheets("Sheet2").Select
Range("a1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
lastrow = Cells(Rows.Count, "b").End(xlUp).Row
Range("b1:b" & lastrow).Copy
Sheets("Sheet2").Select
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lastrow + 1).Select
ActiveSheet.Paste
lastrow = Cells(Rows.Count, "a").End(xlUp).Row

With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:A" & lastrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1").Select
lastrow = Cells(Rows.Count, "c").End(xlUp).Row
Range("c1:c" & lastrow).Copy
Sheets("Sheet2").Select
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lastrow + 1).Select
ActiveSheet.Paste

Thank you very much! I'm on my way. Appreciate that. Regards, Guy

 

[SteveO59L]

no probs, thanks for the feedback