Luke_Ryan23
New Member
- Joined
- Dec 19, 2016
- Messages
- 1
I have writen this code but it is not pulling th info i need into the seperate worksheets??
Private Sub SEND()
Application.DisplayAlerts = False
Dim Issues_all_rows As Integer
Dim Receipts_all_rows As Integer
Dim Stock_all_rows As Integer
Dim Stock_sup_rows As Integer
Dim Receipts_sup_rows As Integer
Dim Issues_sup_rows As Integer
Dim supplier_code As String
Dim supplier_name As String
Dim contact_name As String
Dim to_addresses As String
Dim cc_addresses As String
Dim sup_comments As String
Dim attach_file As String
Dim email_message As String
Dim wb As Workbook
Dim blnSuccessful As Boolean
Dim Outapp As Object
Dim OutMail As Object
Issues_all_rows = Range("F1").Value
Receipts_all_rows = Range("F1").Value
Stock_all_rows = Range("F1").Value
Sheets("Issues").Visible = True
Sheets("Receipts").Visible = True
Sheets("Stock").Visible = True
For Each cell In Sheets("E-mail").Range("D2:D64")
If cell.Value = "a" Then
Issues_sup_rows = cell.Offset(, -3).Value
Receipts_sup_rows = cell.Offset(, -3).Value
Stock_sup_rows = cell.Offset(, -3).Value
supplier_code = cell.Offset(, 1).Value
supplier_name = cell.Offset(, 2).Value
contact_name = cell.Offset(, 3).Value
to_addresses = cell.Offset(, 4).Value
cc_addresses = cell.Offset(, 5).Value
sup_comments = cell.Offset(, 6).Value
attach_file = "S:\DISCO\Disco Data - " & supplier_code & ".xls"
email_message = "<html>" & _
"******>" & _
"Dear " & contact_name & ", <br>" & _
"<br>" & _
"Please find the daily Disco reports attached.<br>" & _
"<br>" & _
"<font color=""red"">" & sup_comments & "</font>" & " <br>" & _
"<br>" & _
"Regards, <br>" & _
"PCC Team" & _
"</body>" & _
"</html>"
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Issues" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Receipts" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Stock" Then
Worksheet.Delete
End If
Next Worksheet
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Issues"
Sheets("Issues").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Issues").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Issues").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Issues").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Receipts"
Sheets("Receipts").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Receipts").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Receipts").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Receipts").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Stock"
Sheets("Stock").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Stock").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Stock").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Stock").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets(Array("Issues", "Receipts", "Stock")).Copy
Set wb = ActiveWorkbook
With wb
Range("A1").Select
.SaveAs attach_file, FileFormat:=56
.Close False
End With
Set Outapp = CreateObject("Outlook.Application")
Set OutMail = Outapp.CreateItem(0)
With OutMail
.To = to_addresses
.CC = cc_addresses
.Subject = "PCC reports for " & supplier_code & " " & supplier_name
.HTMLBody = email_message
.Attachments.Add attach_file
.sentonbehalfofname = ""
.Display
End With
Set OutMail = Nothing
Set Outapp = Nothing
Else
End If
Next cell
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Issues" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Receipts" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Stock" Then
Worksheet.Delete
End If
Next Worksheet
Sheets("Issues").Visible = False
Sheets("Receipts").Visible = False
Sheets("Stock").Visible = False
Range("F1").Select
Application.DisplayAlerts = Ture
Private Sub SEND()
Application.DisplayAlerts = False
Dim Issues_all_rows As Integer
Dim Receipts_all_rows As Integer
Dim Stock_all_rows As Integer
Dim Stock_sup_rows As Integer
Dim Receipts_sup_rows As Integer
Dim Issues_sup_rows As Integer
Dim supplier_code As String
Dim supplier_name As String
Dim contact_name As String
Dim to_addresses As String
Dim cc_addresses As String
Dim sup_comments As String
Dim attach_file As String
Dim email_message As String
Dim wb As Workbook
Dim blnSuccessful As Boolean
Dim Outapp As Object
Dim OutMail As Object
Issues_all_rows = Range("F1").Value
Receipts_all_rows = Range("F1").Value
Stock_all_rows = Range("F1").Value
Sheets("Issues").Visible = True
Sheets("Receipts").Visible = True
Sheets("Stock").Visible = True
For Each cell In Sheets("E-mail").Range("D2:D64")
If cell.Value = "a" Then
Issues_sup_rows = cell.Offset(, -3).Value
Receipts_sup_rows = cell.Offset(, -3).Value
Stock_sup_rows = cell.Offset(, -3).Value
supplier_code = cell.Offset(, 1).Value
supplier_name = cell.Offset(, 2).Value
contact_name = cell.Offset(, 3).Value
to_addresses = cell.Offset(, 4).Value
cc_addresses = cell.Offset(, 5).Value
sup_comments = cell.Offset(, 6).Value
attach_file = "S:\DISCO\Disco Data - " & supplier_code & ".xls"
email_message = "<html>" & _
"******>" & _
"Dear " & contact_name & ", <br>" & _
"<br>" & _
"Please find the daily Disco reports attached.<br>" & _
"<br>" & _
"<font color=""red"">" & sup_comments & "</font>" & " <br>" & _
"<br>" & _
"Regards, <br>" & _
"PCC Team" & _
"</body>" & _
"</html>"
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Issues" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Receipts" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Stock" Then
Worksheet.Delete
End If
Next Worksheet
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Issues"
Sheets("Issues").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Issues").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Issues").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Issues").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Receipts"
Sheets("Receipts").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Receipts").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Receipts").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Receipts").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = "Stock"
Sheets("Stock").Select
Range("A1:AZ1").Select
Selection.Copy
Sheets("Stock").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Stock").Select
Range("A2:AZ" & Issues_sup_rows + 1).Select
Selection.Copy
Sheets("Stock").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Issues_sup_rows = 0 Then Range("A2").Value = "No Data" Else Range("A2:AY" & Issues_sup_rows + 1).Value = "=INDEX('Issues'!$1:$" & Issues_all_rows & ",MATCH(ROW()-1&""" & supplier_code & """,'Issues-DATA'!$A$1:$A$" & Issues_all_rows & ",0),COLUMN()+1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:AY" & Issues_sup_rows + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Selection.AutoFilter
Cells.EntireColumn.AutoFit
Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
Sheets(Array("Issues", "Receipts", "Stock")).Copy
Set wb = ActiveWorkbook
With wb
Range("A1").Select
.SaveAs attach_file, FileFormat:=56
.Close False
End With
Set Outapp = CreateObject("Outlook.Application")
Set OutMail = Outapp.CreateItem(0)
With OutMail
.To = to_addresses
.CC = cc_addresses
.Subject = "PCC reports for " & supplier_code & " " & supplier_name
.HTMLBody = email_message
.Attachments.Add attach_file
.sentonbehalfofname = ""
.Display
End With
Set OutMail = Nothing
Set Outapp = Nothing
Else
End If
Next cell
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Issues" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Receipts" Then
Worksheet.Delete
End If
Next Worksheet
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name = "Stock" Then
Worksheet.Delete
End If
Next Worksheet
Sheets("Issues").Visible = False
Sheets("Receipts").Visible = False
Sheets("Stock").Visible = False
Range("F1").Select
Application.DisplayAlerts = Ture
