Code is sending same chart in all emails

[Sushil_Thakur]

Hi,

I am trying to send more then 35 emails with the help of vba code.
where every mail contain attached Sheet.
in mail body, One data table and graph of the %age.

i am able to do the same as well but main problem is that every time it is sending the same chart in all the mails
Please help.

At the same time code is long and confusing, if some one help me to reduce it.


Please help.......
Here is the code

Public A As String
Public B As String
Public C As String
Sub Email()
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Windows("email macro .xlsm").Activate
Sheets("Dump").Select
Sort
Application.DisplayAlerts = False
'Sheet with data in it
Set ws = Sheets("Dump")
SvPath = "D:\Sushil\email\"
vTitles = "A1:AI1"
vCol = 30
If vCol = 0 Then Exit Sub
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
Application.ScreenUpdating = True
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))
ws.Range("EE:EE").Clear
ws.Range(vTitles).AutoFilter
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

A = SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY") & ".xlsx"
B = MyArr(Itm) & Format(Date, " MM-DD-YY") & ".xlsx"
C = SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY")
ActiveWorkbook.SaveAs A

Pivot
Mail
Delete
Sheets("Dump").Select
ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

Sub Pivot()
Dim x As Integer
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R2940C34", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet4!R3C1", TableName:="PivotTable6", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Sheet4").Select
Cells(3, 1).Select

With ActiveSheet.PivotTables("PivotTable6").PivotFields("AV_BM")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable6").PivotFields("AV_BM").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("PivotTable6").PivotFields("AV_BM").LayoutForm = _
xlTabular
With ActiveSheet.PivotTables("PivotTable6").PivotFields("HA_BM")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable6").PivotFields("RSM")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable6").PivotFields("RM")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable6").PivotFields("HA_AM")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables("PivotTable6").PivotFields("AV_AM")
.Orientation = xlRowField
.Position = 6
End With
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Range(Selection, Selection.End(xlToLeft)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range("$A$1:$B$21").RemoveDuplicates Columns:=Array(1, 2), Header _
:=xlYes
Selection.Replace What:="(blank)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Grand total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveCell.FormulaR1C1 = "TO"
Range("B1").Select
ActiveCell.FormulaR1C1 = "CC"
Range("J1").Select
Sheets("Sheet1").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R2940C34", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet5!R3C1", TableName:="PivotTable7", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Sheet5").Select
Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
"PivotTable7").PivotFields("SERIAL"), "Count of SERIAL", xlCount
With ActiveSheet.PivotTables("PivotTable7").PivotFields("VALIDATION")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("AV_AM")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Count of SERIAL")
.Calculation = xlPercentOfRow
.NumberFormat = "0.00%"
End With
With ActiveSheet.PivotTables("PivotTable7")
.ColumnGrand = False
.RowGrand = False
End With
Selection.End(xlToRight).Select
Range("B4").Select
Selection.End(xlToRight).Select
Range("G3").Select
Sheets("Sheet1").Select
Sheets.Add
ActiveWorkbook.Worksheets("Sheet5").PivotTables("PivotTable7").PivotCache. _
CreatePivotTable TableDestination:="Sheet6!R3C1", TableName:="PivotTable8" _
, DefaultVersion:=xlPivotTableVersion12
Sheets("Sheet6").Select
Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
"PivotTable8").PivotFields("SERIAL"), "Count of SERIAL", xlCount
With ActiveSheet.PivotTables("PivotTable8").PivotFields("VALIDATION")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable8").PivotFields("AV_AM")
.Orientation = xlRowField
.Position = 1
End With



Sheets("Sheet6").Select
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet4").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet5").Select
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Sheet4"
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select

Cells.Columns.AutoFit
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Application.DisplayAlerts = False
Sheets("Sheet5").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet6").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Sheet4").Select
Range("L2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Style = "Percent"
Range("P3").Select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
fill
Range("P3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("O:P").Select
Selection.Delete Shift:=xlToLeft
Application.CutCopyMode = False

Cells.Select
Selection.Replace What:="SERIAL BILLED TO OTHER DEALER IN MCS/DMS/SAP", _
Replacement:="BILLED TO OTHER DEALER", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Row Labels", _
Replacement:="AM", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:="SERIAL RECORD NOT FOUND IN MCS/DMS/SAP", Replacement:= _
"RECORD NOT FOUND", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="@samsung.com", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Chart


Chart_delete

Cells.Select
Selection.Copy
Windows("email macro .xlsm").Activate
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(B).Activate
ActiveWindow.Close
Windows("email macro .xlsm").Activate
Sheets("Sheet1").Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Columns.AutoFit
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With



End Sub

Sub Mail()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim rCell As Range, sAddys As String
Dim sCell As Range, tAddys As String


Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Snapshot").Range("A3:J9").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
With ThisWorkbook.Sheets("Sheet1")
For Each rCell In .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
If rCell.Value <> "" Then sAddys = sAddys & rCell.Value & "; "

Next rCell
End With
OutMail.To = sAddys

With ThisWorkbook.Sheets("Sheet1")
For Each sCell In .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
If sCell.Value <> "" Then tAddys = tAddys & sCell.Value & "; "

Next sCell

End With
OutMail.cc = tAddys

.Subject = "Validation Dashboard Till - " & " " & Date
.HTMLBody = "Dear Manager

" & "
		
		
	


	

		
	
" & "

Please find Below updated validation till Date.

" & RangetoHTML(rng) & "

" & "

		
	
" & "

Please find the attached file for your reference. 

Feel free to revert back in case of any clarification of concern. 

Thanks & Regards,"

.Attachments.Add A
.display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

TempWB.Close savechanges:=False

Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Sub Delete()
'You can use this to delete all/anyfile type from folders
On Error Resume Next
Kill "D:\Sushil\email\chart1.png"
On Error GoTo 0
End Sub
Sub fill()
Dim mrow As Long
Sheets("Sheet4").Select
mrow = Sheets("Sheet4").Range("O1048576").End(xlUp).Row
If mrow > 3 Then
Sheets("Sheet4").Range("P3:P" & mrow).FillDown
Sheets("Sheet4").Range("P3:P" & mrow).Calculate
Sheets("Sheet4").Range("P3:P" & mrow).Copy
Sheets("Sheet4").Range("P3").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Range("P3").Select
Application.CutCopyMode = False
Selection.Copy
Range("P3").Select
ActiveSheet.Paste
End Sub
Sub Chart()

Range("L2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("Sheet4!$L$2:$N$7")
ActiveChart.ChartType = xlColumnStacked
ActiveChart.SeriesCollection(1).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(1).Interior.Color = RGB(0, 153, 64)
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
Selection.ClearFormats
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Chart.Export "D:\Sushil\email\Chart1.png"
End Sub
Sub Chart_delete()
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Parent.Delete
End Sub

Sub Sort()
Dim mrow As Long
Range("AB1:AG1").Select
Range("AG1").Activate
Application.CutCopyMode = False
Selection.Copy
Range("AI1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AB1").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"AB1:AB238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]&""@samsung.com"""
ActiveSheet.Select
mrow = ActiveSheet.Range("AB1048576").End(xlUp).Row
If mrow > 2 Then
ActiveSheet.Range("AI2:AI" & mrow).FillDown
ActiveSheet.Range("AI2:AI" & mrow).Calculate
ActiveSheet.Range("AI2:AI" & mrow).Copy
ActiveSheet.Range("AI2").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Range("AC1").Select
Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"AC1:AC238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]&""@samsung.com"""
ActiveSheet.Select
mrow = ActiveSheet.Range("AC1048576").End(xlUp).Row
If mrow > 2 Then
ActiveSheet.Range("AJ2:AJ" & mrow).FillDown
ActiveSheet.Range("AJ2:AJ" & mrow).Calculate
ActiveSheet.Range("AJ2:AJ" & mrow).Copy
ActiveSheet.Range("AJ2").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Range("AD1").Select
Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"AD1:AD238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AK2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]&""@samsung.com"""
ActiveSheet.Select
mrow = ActiveSheet.Range("AD1048576").End(xlUp).Row
If mrow > 2 Then
ActiveSheet.Range("AK2:AK" & mrow).FillDown
ActiveSheet.Range("Ak2:Ak" & mrow).Calculate
ActiveSheet.Range("Ak2:Ak" & mrow).Copy
ActiveSheet.Range("Ak2").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Range("AF1").Select
Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"Af1:Af238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("AM2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]&""@samsung.com"""
ActiveSheet.Select
mrow = ActiveSheet.Range("AE1048576").End(xlUp).Row
If mrow > 2 Then
ActiveSheet.Range("AM2:AM" & mrow).FillDown
ActiveSheet.Range("AM2:AM" & mrow).Calculate
ActiveSheet.Range("AM2:AM" & mrow).Copy
ActiveSheet.Range("AM2").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Range("AG1").Select
Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"AG1:AG238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("AN2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]&""@samsung.com"""
ActiveSheet.Select
mrow = ActiveSheet.Range("AE1048576").End(xlUp).Row
If mrow > 2 Then
ActiveSheet.Range("An2:An" & mrow).FillDown
ActiveSheet.Range("An2:An" & mrow).Calculate
ActiveSheet.Range("An2:An" & mrow).Copy
ActiveSheet.Range("An2").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Columns("AB:AG").Select
Range("AG1").Activate
Selection.Delete Shift:=xlToLeft
Columns("AB:AB").Select
Selection.Cut
Columns("AI:AI").Select
ActiveSheet.Paste
Columns("AB:AB").Select
Selection.Delete Shift:=xlToLeft

Range("AD1").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort.SortFields.Add Key:=Range( _
"AD1:AD238132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dump").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter

End Sub

Please help.......