JackMouct
12-23-2016, 08:30 AM
Hello Everyone, i have used below code to create new workbook and save as with password protection. Now i would like to add email code to be sent out to multiple recipient. Please note "summary tab" Column B2 email list corresponding to column A2 which has been used to create these workbooks. For example, if Column A2 which call "PCP" then workbook "PCP" saved needs to be sent Column B2 which is tranvel@bbt.com. In another, column A2 to be sent B2 (email), A3 to be sent B3 etc...... Please any help will be much appreciated. Thank you again for your help
Dim Master_Sht As Worksheet, Summary_Sht As Worksheet, New_Sht As Worksheet, Third_Sht As WorksheetDim rCell_Summary As Range, rCell_ThirdReports As Range
Dim Summary_Last_Row As Long, New_Sht_Next_Row As Long
Dim Total1 As Double
Dim New_Wkbk As Workbook, thisWb As Workbook
Dim fileName As String, Password As String
Application.ScreenUpdating = False
Set Master_Sht = Sheets("Third Reports")
Set Summary_Sht = Sheets("Summary")
Set Third_Sht = Sheets("Third Reports")
Summary_Last_Row = Summary_Sht.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell_Summary In Summary_Sht.Range("A2:A" & Summary_Last_Row)
Set New_Wkbk = Workbooks.Add
Set New_Sht = New_Wkbk.Sheets(1)
With New_Sht
.Name = rCell_Summary.Value
.Range("A1").Value = "Pers.No."
.Range("B1").Value = "Last name First name"
.Range("C1").Value = "Name of employee or applicant"
.Range("D1").Value = "ID number"
.Range("E1").Value = "Wage Type Long Text"
.Range("F1").Value = "Amount"
.Range("G1").Value = "Crcy"
End With
For Each rCell_ThirdReports In Third_Sht.Range("E2:E100000")
If rCell_ThirdReports.Value = rCell_Summary.Value Then
New_Sht_Next_Row = Application.WorksheetFunction.CountA(New_Sht.Range("A:A")) + 1
New_Sht.Cells(New_Sht_Next_Row, 1).Resize(, 6).Value = Third_Sht.Cells(rCell_ThirdReports.Row, 1).Resize(, 6).Value 'a bit quicker
End If
Next rCell_ThirdReports
Set New_Wkbk = ActiveWorkbook
With New_Sht
Total1 = Application.WorksheetFunction.Sum(.Range("F:F"))
.Cells(New_Sht_Next_Row + 2, 6).Value = Total1
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit
End With
With New_Wkbk
New_Wkbk.SaveAs rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")
Application.DisplayAlerts = False
Set thisWb = ActiveWorkbook
With thisWb
.SaveAs fileName:=thisWb.Path, Password:="SSC"
.Close savechanges:=False
End With
Application.DisplayAlerts = True
'New_Wkbk.SaveAs fileName:="G:\Central Services\Retails Sales\Controls\Control Reports\Third Party\December 2016, & "".xls"", FileFormat:=xlNormal, Password:=""SSC"", WriteResPassword:="", ReadOnlyRecommended:=False,CreateBackup:=False"
End With
Next rCell_Summary
Set Master_Sht = Nothing
Set Summary_Sht = Nothing
Set Third_Sht = Nothing
Set New_Sht = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Dim Master_Sht As Worksheet, Summary_Sht As Worksheet, New_Sht As Worksheet, Third_Sht As WorksheetDim rCell_Summary As Range, rCell_ThirdReports As Range
Dim Summary_Last_Row As Long, New_Sht_Next_Row As Long
Dim Total1 As Double
Dim New_Wkbk As Workbook, thisWb As Workbook
Dim fileName As String, Password As String
Application.ScreenUpdating = False
Set Master_Sht = Sheets("Third Reports")
Set Summary_Sht = Sheets("Summary")
Set Third_Sht = Sheets("Third Reports")
Summary_Last_Row = Summary_Sht.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell_Summary In Summary_Sht.Range("A2:A" & Summary_Last_Row)
Set New_Wkbk = Workbooks.Add
Set New_Sht = New_Wkbk.Sheets(1)
With New_Sht
.Name = rCell_Summary.Value
.Range("A1").Value = "Pers.No."
.Range("B1").Value = "Last name First name"
.Range("C1").Value = "Name of employee or applicant"
.Range("D1").Value = "ID number"
.Range("E1").Value = "Wage Type Long Text"
.Range("F1").Value = "Amount"
.Range("G1").Value = "Crcy"
End With
For Each rCell_ThirdReports In Third_Sht.Range("E2:E100000")
If rCell_ThirdReports.Value = rCell_Summary.Value Then
New_Sht_Next_Row = Application.WorksheetFunction.CountA(New_Sht.Range("A:A")) + 1
New_Sht.Cells(New_Sht_Next_Row, 1).Resize(, 6).Value = Third_Sht.Cells(rCell_ThirdReports.Row, 1).Resize(, 6).Value 'a bit quicker
End If
Next rCell_ThirdReports
Set New_Wkbk = ActiveWorkbook
With New_Sht
Total1 = Application.WorksheetFunction.Sum(.Range("F:F"))
.Cells(New_Sht_Next_Row + 2, 6).Value = Total1
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit
End With
With New_Wkbk
New_Wkbk.SaveAs rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")
Application.DisplayAlerts = False
Set thisWb = ActiveWorkbook
With thisWb
.SaveAs fileName:=thisWb.Path, Password:="SSC"
.Close savechanges:=False
End With
Application.DisplayAlerts = True
'New_Wkbk.SaveAs fileName:="G:\Central Services\Retails Sales\Controls\Control Reports\Third Party\December 2016, & "".xls"", FileFormat:=xlNormal, Password:=""SSC"", WriteResPassword:="", ReadOnlyRecommended:=False,CreateBackup:=False"
End With
Next rCell_Summary
Set Master_Sht = Nothing
Set Summary_Sht = Nothing
Set Third_Sht = Nothing
Set New_Sht = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub