How do copy paste last row for table range on outlook?

Question

how do I last row for table range instead of giving a specific range value for outlook ? (X:X) 

Public Sub Insert_Charts_In_New_Email1()


Dim outApp As Object 'Outlook.Application ( to sent workbook)
Dim outMail As Object 'Outlook.MailItem   ( to open outlook)
Dim wEditor As Object 'Word.Document (responsible for charts)
Dim wRange As Object 'Word.Range ( for texts)
Dim chartsSheet As Object
Dim rng_dear As Range
Dim rng1_overalltext As Range
Dim rng2_testexec As Range
Dim rng3_critmajor As Range
Dim rng4_jiralist As Range
Dim rng5_overall As Range
Dim rng6_detaildefectreport As Range
Dim rng7_ageingdefectreport As Range
Dim rng8_thanks As Range
Dim chartObj As Object

'Setting named Sheets

Set chartsSheet = Sheets("Defects")
Set chartsSheet2 = Sheets("Test Execution (Manual)")
Set chartsSheet3 = Sheets("Ageing JIRAs")
Set chartsSheet4 = Sheets("JIRA_List")
Set chartsSheet5 = Sheets("Summary-Guidelines")


'Only send the visible cells in the selection for table

Set rng_dear = Sheets("Summary-Guidelines").Range("B4:E8").SpecialCells(xlCellTypeVisible)
Set rng1_overalltext = Sheets("Summary-Guidelines").Range("B18:F32").SpecialCells(xlCellTypeVisible)
Set rng5_overall = Sheets("Summary-Guidelines").Range("Overall_Test_Status").SpecialCells(xlCellTypeVisible)
Set rng2_testexec = Sheets("Test Execution (Manual)").Range("A58:L64").SpecialCells(xlCellTypeVisible)
Set rng3_critmajor = Sheets("Defects").Range("A61:F64").SpecialCells(xlCellTypeVisible)
Set rng6_detaildefectreport = Sheets("Defects").Range("A5:C5").SpecialCells(xlCellTypeVisible)
Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)
Set rng7_ageingdefectreport = Sheets("Ageing JIRAs").Range("A1:E3").SpecialCells(xlCellTypeVisible)
Set rng8_thanks = Sheets("Ageing JIRAs").Range("H38:H40").SpecialCells(xlCellTypeVisible)


With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Dim strbody As String
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)



With outMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Sheets("Summary-Guidelines").Range("C2").Value & " - " & Sheets("Summary-Guidelines").Range("C3").Value & " - " & "Status as of " & Format(Date, "dd/mm/yyyy")

'Put in table '
.HTMLBody = RangetoHTML(rng_dear) & RangetoHTML4(rng5_overall) & RangetoHTML0(rng1_overalltext) & RangetoHTML5(rng6_detaildefectreport) & RangetoHTML1(rng2_testexec) & "<br>" & Sheets("Defects").Range("A7").Value & "<br>" & "<br>" & Sheets("Defects").Range("A35").Value & RangetoHTML2(rng3_critmajor) & "<br>" & Sheets("Defects").Range("A68").Value & "<br>" & "<br>" & Sheets("Summary-Guidelines").Range("B44").Value & RangetoHTML3(rng4_jiralist) & RangetoHTML6(rng7_ageingdefectreport) & "<br>" & Sheets("Ageing JIRAs").Range("H34").Value & "<br>" & Sheets("Ageing JIRAs").Range("H35").Value & "<br>" & Sheets("Ageing JIRAs").Range("H36").Value & RangetoHTML7(rng8_thanks)

.Display
End With


With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set outMail = Nothing
Set outApp = Nothing

Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)


Set wEditor = outApp.ActiveInspector.WordEditor
Set wRange = wEditor.Application.ActiveDocument.Content


wRange.Collapse 1 'Direction:=wdCollapseStart

wRange.InsertAfter " " & vbNewLine
wRange.Collapse 0 'Direction:=wdCollapseEnd

'Putting charts in outlook

Set chartObj = chartsSheet2.ChartObjects("Chart 1")
Insert_Resized_Chart chartObj, wRange
wEditor.Application.ActiveDocument.InlineShapes(1).Width = 850
wEditor.Application.ActiveDocument.InlineShapes(1).Height = 300
wRange.Collapse 0 'Direction:=wdCollapseEnd


Set chartObj = chartsSheet.ChartObjects("Chart 1")
Insert_Resized_Chart chartObj, wRange
wEditor.Application.ActiveDocument.InlineShapes(2).Width = 400
wEditor.Application.ActiveDocument.InlineShapes(2).Height = 200

Eng Sub

Answer 1

Public Sub Insert_Charts_In_New_Email1()

Dim rng4_jiralist As Range
Dim outApp As Object 'Outlook.Application ( to sent workbook)
Dim outMail As Object 'Outlook.MailItem   ( to open outlook)
Dim wEditor As Object 'Word.Document (responsible for charts)
Dim wRange As Object 'Word.Range ( for texts)
Dim chartObj As Object

Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Dim strbody As String
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)

With outMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Sheets("Summary-Guidelines").Range("C2").Value & " - " & Sheets("Summary-Guidelines").Range("C3").Value & " - " & "Status as of " & Format(Date, "dd/mm/yyyy")

'Put in table '
.HTMLBody = RangetoHTML5(rng4_jiralist)
.Display
End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set outMail = Nothing
Set outApp = Nothing

Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)

Set wEditor = outApp.ActiveInspector.WordEditor
Set wRange = wEditor.Application.ActiveDocument.Content

wRange.Collapse 1 'Direction:=wdCollapseStart

wRange.InsertAfter " " & vbNewLine
wRange.Collapse 0 'Direction:=wdCollapseEnd

Eng Sub

Function RangetoHTML3(rng4_jiralist As Range)
' By Ron de Bruin.
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"

'Copy the range and create a new workbook to past the data in
rng4_jiralist.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

'Publish the sheet to a htm file
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

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML3 = ts.ReadAll
ts.Close
RangetoHTML3 = Replace(RangetoHTML3, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

how do I last row for table range instead of giving a specific range value for outlook ? Instead of

Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)

Answer 2

Hi keirax3,

I can see that you had copy the many ranges from the worksheet.

so here I assume that instead of setting the range you want to get the last row of the sheet.

for that , you can use code like below.

Dim sht As Worksheet
Dim LastRow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")


  LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

'Using UsedRange

  sht.UsedRange 'Refresh UsedRange
  LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row

'Using Table Range

  LastRow = sht.ListObjects("Table1").Range.Rows.Count

'Using Named Range

  LastRow = sht.Range("MyNamedRange").Rows.Count

'or

  LastRow = sht.Range("A1").CurrentRegion.Rows.Count

you can try to use the one which is suitable for you.

if I misunderstand something in your requirement then let me know about that, I will try to provide further suggestions to solve the issue.

Regards

Deepak

---

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact [e-mail].