Send just page one of active sheet by email|VBA & Macros|Excel Forum|My Online Training Hub

Hello,

It would be easier to copy all the data of the rows and columns that you want to send by email and paste in a new sheet and from there send the email,

but I will leave here a way to identify the first page break, I hope I can help.

for this example I used a command button to call the page break identification procedure

Private Sub CommandButton1_Click()

Dim Wsheet As Worksheet
Dim HorizontalPageBreak As HPageBreak
Dim VerticalPageBreak As VPageBreak
Dim rng As Range

Set Wsheet = ActiveSheet ' OR CHANGE TO ANY SHEET NAME YOU WANT: Application.ThisWorkbook.Worksheets ("Sheet1")

' FOR HORIZONTAL PAGE BREAK
For Each HorizontalPageBreak In Wsheet.HPageBreaks
     Debug.Print HorizontalPageBreak.Location.Address
Next HorizontalPageBreak

' FOR VERTICAL PAGE BREAK
For Each VerticalPageBreak In Wsheet.VPageBreaks
     Debug.Print VerticalPageBreak.Location.Address
Next VerticalPageBreak

' FIRST PAGE BREAK IS ALWAYS (1) ... FOR SECOND PAGE BREAK IS (2) ... etc
Set rng = Wsheet.Range(Wsheet.HPageBreaks(1).Location.Offset(-1, 0), Wsheet.VPageBreaks(1).Location.Offset(0, -1))
Debug.Print rng.Address

rng.Select

MsgBox "All ranges of the page break: " & rng.Address

If Not Wsheet Is Nothing Then Set Wsheet = Nothing
If Not rng Is Nothing Then Set rng = Nothing

End Sub

Once the first page break is identified and selected, you can use it to copy this data or send...

Miguel,

Hello,

the Purfleet method is correct, but if you don't want to remove the command button, you can simply make it invisible at the beginning of the procedure and visible at the end

and as there is no more data on your excel sheet below line 53, there is no reason to copy and paste it on another sheet...

Something similar to this:

Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = False

&

Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = True

I highlighted the changes in blue, I tested it with my outlook and it worked perfectly

Private Sub CommandButton1_Click()

Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim FileExt As String
Dim TempFileName As String
Dim FileFullPath As String
Dim FileFormat As Variant
Dim Wb1 As Workbook
Dim Wb2 As Workbook

Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = False

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Wb1 = ThisWorkbook
ActiveSheet.Copy
Set Wb2 = ActiveWorkbook

With Wb2
     If Val(Application.Version) < 12 Then
          FileExt = ".xls": FileFormat = -4143
     Else
          Select Case Wb1.FileFormat
               Case 51: FileExt = ".xlsx": FileFormat = 51
               Case 52:
               If .HasVBProject Then
                    FileExt = ".xlsm": FileFormat = 52
               Else
                    FileExt = ".xlsx": FileFormat = 51
               End If
               Case 56: FileExt = ".xls": FileFormat = 56
               Case Else: FileExt = ".xlsb": FileFormat = 50
          End Select
     End If
End With

TempFilePath = Environ$("temp") & "\"

TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")

FileFullPath = TempFilePath & TempFileName & FileExt

Wb2.SaveAs FileFullPath, FileFormat:=FileFormat

Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)

On Error Resume Next
With NewMail
     .To = "ADD YOUR EMAIL HERE"
     .CC = ""
     .Subject = "Ident"
     .Body = "Kan dere vennligst sende Ident"
     .Attachments.Add FileFullPath
     .Display
End With
On Error GoTo 0

Wb2.Close SaveChanges:=False
Kill FileFullPath

Set NewMail = Nothing
Set OlApp = Nothing

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

Application.ThisWorkbook.Worksheets("Rep skjema").Activate
Application.ThisWorkbook.Worksheets("Rep skjema").CommandButton1.Visible = True

End Sub

Miguel,