INVOICE EXCEL VBA, GENERATE DYNAMIC INVOICE IN VBA INVOICE

Excel VBA, which stands for Visual Basic for Applications, is a programming language that allows users to automate tasks and create customized solutions within Microsoft Excel. It enables users to create macros, which are sets of instructions that can automatically perform repetitive tasks.

Automatic Excel Invoice creation in VBA

Option Explicit
Option Base 1

Sub headerdetail()
Dim cust As String, i As Integer, rg As Range, lrow As Integer, myresult As Variant

'lrow = Sheets("customer").Range("a100000").End(xlUp).Row

Sheets("sheet1").Range("L5").Value = Format(Date, "YYYY/MM/DD")
Sheets("sheet2").Range("G3").Copy Sheets("sheet1").Range("i5")
Sheets("sheet1").Range("i5").Font.Bold = True
Sheets("sheet2").Range("c4").Copy Sheets("sheet1").Range("i15")
Sheets("sheet1").Range("i15").Font.Bold = True
Sheets("sheet2").Range("c5").Copy Sheets("sheet1").Range("M15")
Sheets("sheet1").Range("M15").Font.Bold = True
Sheets("sheet2").Range("g4").Copy Sheets("sheet1").Range("l19")
Sheets("sheet1").Range("l19").Font.Bold = True
Sheets("sheet2").Range("g5").Copy Sheets("sheet1").Range("L20")
Sheets("sheet1").Range("L20").Font.Bold = True

cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 0).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("B11").Select
    ActiveSheet.Paste
    ActiveCell.Font.Bold = True
    
          
    
    'lin 2
    cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 1).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("a12").Select
    ActiveSheet.Paste
    
    'line3
    cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 2).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("a13").Select
    ActiveSheet.Paste
    
    'ine 4
    cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 3).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("a14").Select
    ActiveSheet.Paste
    
    'line5 phone
    cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 4).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("B16").Select
    ActiveSheet.Paste
   
    
    
    'gst past
    
    cust = Sheets("sheet2").Range("c3").Value
Sheets("customer").Select
    Range("A1").Select
    Cells.Find(What:=cust, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 5).Copy
    
    'Range("B6").Select
    
    'Selection.Copy
    Sheets("Sheet1").Select
    Range("f15").Select
    ActiveSheet.Paste
    Range("f15").Select
    Range("f17").Value = Left(Range("f15"), 2)
    
    'Range("d50").Select
  
  Call invoices
  Call filesave
  Call formating
  
End Sub

Sub invoices()

Dim i As Integer, itemrow As Integer, j As Integer, qty As Integer, pr As Double, dis As Integer, total As Double
Dim ri As Integer, subtotal As Double, finaltotal As Double, r1 As String, r2 As String, totalvalue As Range
Dim gtotal As Double, gt1 As String, gt2 As String, gt As Range
Dim ins1 As Integer, ins2 As Integer

itemrow = Sheets("sheet2").Range("b8").End(xlDown).Row
j = 24

If itemrow > 15 Then
ri = itemrow - 11
Sheets("sheet1").Range("b24:b" & j + ri).EntireRow.Insert

End If
For i = 8 To itemrow
Sheets("sheet2").Range("b" & i).Copy
Sheets("Sheet1").Select

Range("b" & j).Select
ActiveSheet.Paste

Sheets("sheet2").Range("b" & i).Offset(0, 1).Copy
Sheets("sheet1").Range("a" & j).Value = j - 23
Sheets("sheet1").Range("b" & j).Offset(0, 1).Select
ActiveSheet.Paste

Sheets("sheet2").Range("b" & i).Offset(0, 3).Copy
Sheets("sheet1").Range("b" & j).Offset(0, 8).Select
ActiveSheet.Paste
  
 qty = ActiveCell.Value
 
 

Sheets("sheet2").Range("b" & i).Offset(0, 4).Copy
Sheets("sheet1").Range("b" & j).Offset(0, 9).Select
ActiveSheet.Paste
pr = ActiveCell.Value

Sheets("sheet2").Range("b" & i).Offset(0, 5).Copy
Sheets("sheet1").Range("b" & j).Offset(0, 10).Select
ActiveSheet.Paste

Sheets("sheet2").Range("b" & i).Offset(0, 6).Copy
Sheets("sheet1").Range("b" & j).Offset(0, 11).Select
ActiveSheet.Paste
dis = ActiveCell.Value

total = qty * pr
ActiveCell.Offset(0, 1).Select

ActiveCell.Value = total - (total * dis / 100)

j = j + 1

Next
ActiveCell.Select
 If ri = 0 Then
    
     Sheets("sheet1").Range("m36").Value = "INSURANCE"
     Sheets("sheet1").Range("m36").Select
     ActiveCell.Offset(-1, 0).Value = "SUBTOTAL"
     
     ActiveCell.Select
    
    r1 = ActiveCell.Offset(0, 1).End(xlUp).End(xlUp).Address
     r2 = ActiveCell.Offset(0, 1).End(xlUp).Address
    Set totalvalue = Range(r1 & ":" & r2)
     subtotal = WorksheetFunction.Sum(totalvalue)
     
     
     ActiveCell.Offset(-1, 1).Value = subtotal
     'ActiveCell.Offset(-1, -1).Value = "Subtotal"
        ActiveCell.Offset(0, 1).Value = (subtotal * 0.104) / 100
        ins1 = ActiveCell.Offset(0, 1).Value
        
        If Range("F5").Value = Range("f17").Value Then
        ActiveCell.Offset(1, 0).Value = "CGST 9%"
        ActiveCell.Offset(1, 1).Value = ((subtotal + ins1) * 9) / 100
        
        ActiveCell.Offset(2, 0).Value = "SGST 9%"
        ActiveCell.Offset(2, 1).Value = ((subtotal + ins1) * 9) / 100
        
        Else
     ActiveCell.Offset(1, 0).Value = "IGST 18%"
    ActiveCell.Offset(1, 1).Value = ((subtotal + ins1) * 18) / 100
    End If
    
    
     gt1 = ActiveCell.Offset(3, 1).Address
    gt2 = ActiveCell.Offset(-1, 1).Address
         Set gt = Range(gt1 & ":" & gt2)
     gtotal = WorksheetFunction.Sum(gt)
    
    ActiveCell.Offset(4, 0).Value = "Grand Total"
    ActiveCell.Offset(4, 0).Font.Bold = True
    ActiveCell.Offset(4, 1).Value = gtotal
    ActiveCell.Offset(4, 1).Font.Bold = True
    'Range(ActiveCell.Offset(4, 1), ActiveCell.Offset(4, -12)).Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin
   
    
    'start setting
   Range(ActiveCell.Offset(-1, 0), ActiveCell.Offset(-1, -1)).Merge
   Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -1)).Merge
   Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, -1)).Merge
   Range(ActiveCell.Offset(3, 0), ActiveCell.Offset(3, -1)).Merge
   
    ActiveCell.Offset(-1, 0).Select
   Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        
    End With
      
        'statr format
    ActiveCell.Offset(7, -11).Select
    Range(ActiveCell, ActiveCell(, 14)).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    ActiveCell.Value = "Total Weight (KG/LTR) :"
    ActiveCell.Offset(0, 4).Value = "weight"
    ActiveCell.Offset(0, 6).Value = "Reference :"
    ActiveCell.Offset(0, 12).Value = "Customer Debit No. :"
    
    
    'ActiveCell.Offset(2, 0).Value = "Amount In Words"
    ActiveCell.Offset(1, 0).Value = NUM_TO_IND_RUPEE_WORD(gtotal)
    ActiveCell.Offset(1, 0).Font.Bold = True
    ActiveCell.Offset(1, 0).Font.Size = 10
    
    
    ActiveCell.Offset(4, 0).Value = "Company's GST No."
    ActiveCell.Offset(4, 3).Value = "06AAZCS5957N1Z4"
    ActiveCell.Offset(4, 10).Value = "Date & Time of Invoice:"
    ActiveCell.Offset(5, 0).Value = "Buyer's GST No. :"
    
    Sheets("sheet1").Range("f15").Cut ActiveCell.Offset(5, 3)
    
    'ActiveCell.Offset(5, 3).Value = "19ACWPA2449K1Z4"
    ActiveCell.Offset(5, 10).Value = "Date & Time of Removal:"
    ActiveCell.Offset(7, 0).Value = "Declaration"
    ActiveCell.Offset(7, 0).Font.Bold = True
    ActiveCell.Offset(7, 10).Value = "For STANVAC PRIME PRIVATE LTD."
    ActiveCell.Offset(8, 0).Value = "Certified that the particulars given above are true and correct and the amount"
    ActiveCell.Offset(8, 0).Font.Size = 9
    ActiveCell.Offset(8, 0).Font.Italic = True
    
    ActiveCell.Offset(9, 0).Value = "indicated represents the price actually charged and that there is no flow of"
    ActiveCell.Offset(9, 0).Font.Size = 9
    ActiveCell.Offset(9, 0).Font.Italic = True
    
    
    ActiveCell.Offset(9, 10).Value = "Authorised Signatory"
    
    ActiveCell.Offset(10, 0).Value = "additional consideration directly or indirectly from the buyer."
    ActiveCell.Offset(10, 0).Font.Size = 9
    ActiveCell.Offset(10, 0).Font.Italic = True
     
    
    
Else
    ActiveCell.Offset(2, 0).Select
    
    r1 = ActiveCell.Offset(-1, 0).End(xlUp).End(xlUp).Address
     r2 = ActiveCell.Offset(1, 0).End(xlUp).Address
    Set totalvalue = Range(r1 & ":" & r2)
     subtotal = WorksheetFunction.Sum(totalvalue)
    
    'subtotal = Application.WorksheetFunction.Sum(Range(("n24"): ActiveCell.Offset(0, 0).Value))
    
    
    ActiveCell.Offset(1, -1).Value = "SUBTOTAL"
    ActiveCell.Offset(2, -1).Value = "INSURANCE"
    ActiveCell.Offset(1, 0).Value = subtotal
    ActiveCell.Offset(2, 0).Value = (subtotal * 0.104) / 100
    ins1 = ActiveCell.Offset(2, 0).Value
    
    If Range("F5").Value = Range("f17").Value Then
    ActiveCell.Offset(3, -1).Value = "CGST 9%"
    ActiveCell.Offset(3, 0).Value = ((subtotal + ins1) * 9) / 100
    
     ActiveCell.Offset(4, -1).Value = "CGST 9%"
     ActiveCell.Offset(4, 0).Value = ((subtotal + ins1) * 9) / 100
    
    Else
    
    ActiveCell.Offset(3, -1).Value = "IGST 18%"
    ActiveCell.Offset(3, 0).Value = ((subtotal + ins1) * 18) / 100
    End If
    
    gt1 = ActiveCell.Offset(4, 0).Address
    gt2 = ActiveCell.Offset(1, 0).Address
         Set gt = Range(gt1 & ":" & gt2)
     gtotal = WorksheetFunction.Sum(gt)
    
    ActiveCell.Offset(6, -1).Value = "Grand Total"
    ActiveCell.Offset(6, 0).Value = gtotal
    
    ActiveCell.Select
   
    'ActiveCell.Offset(1, -1).Select
    Range(ActiveCell.Offset(1, -1), ActiveCell.Offset(1, -2)).Merge
   Range(ActiveCell.Offset(2, -1), ActiveCell.Offset(2, -2)).Merge
   Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(3, -2)).Merge
   
    ActiveCell.Offset(1, -1).Select
   Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        
    End With
    ActiveCell.Offset(7, -11).Select
    Range(ActiveCell, ActiveCell(0, 14)).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveCell.Value = "Total Weight (KG/LTR) :"
    ActiveCell.Offset(0, 4).Value = "weight"
    ActiveCell.Offset(0, 6).Value = "Reference :"
    ActiveCell.Offset(0, 12).Value = "Customer Debit No. :"
    
    ActiveCell.Offset(1, 0).Value = NUM_TO_IND_RUPEE_WORD(gtotal)
    ActiveCell.Offset(1, 0).Font.Bold = True
    ActiveCell.Offset(1, 0).Font.Size = 10
    
    ActiveCell.Offset(4, 0).Value = "Company's GST No."
    ActiveCell.Offset(4, 3).Value = "06AAZCS5957N1Z4"
    ActiveCell.Offset(4, 10).Value = "Date & Time of Invoice:"
    ActiveCell.Offset(5, 0).Value = "Buyer's GST No. :"
    
    Sheets("sheet1").Range("f15").Cut ActiveCell.Offset(5, 3)
    'ActiveCell.Offset(5, 3).Value = "19ACWPA2449K1Z4"
    
    ActiveCell.Offset(5, 10).Value = "Date & Time of Removal:"
    ActiveCell.Offset(7, 0).Value = "Declaration"
     ActiveCell.Offset(7, 0).Font.Bold = True
    ActiveCell.Offset(7, 10).Value = "For STANVAC PRIME PRIVATE LTD."
    ActiveCell.Offset(8, 0).Value = "Certified that the particulars given above are true and correct and the amount"
    ActiveCell.Offset(8, 0).Font.Size = 9
    ActiveCell.Offset(8, 0).Font.Italic = True
    
    ActiveCell.Offset(9, 0).Value = "indicated represents the price actually charged and that there is no flow of"
    ActiveCell.Offset(9, 0).Font.Size = 9
    ActiveCell.Offset(9, 0).Font.Italic = True
    
    ActiveCell.Offset(9, 10).Value = "Authorised Signatory"
    
    ActiveCell.Offset(10, 0).Value = "additional consideration directly or indirectly from the buyer."
    ActiveCell.Offset(10, 0).Font.Size = 9
    ActiveCell.Offset(10, 0).Font.Italic = True

    
End If

ActiveCell.Offset(12, 0).Select
Range(ActiveCell, ActiveCell(0, 14)).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

End Sub
Sub filesave()

Dim LocationSave As String, name As Variant

name = "SPG -" & Right(Sheets("sheet2").Range("g3").Value, 4)

LocationSave = "D:\invoice\" & name & ".pdf"
'ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=LocationSave
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=LocationSave

MsgBox "Invoice Generate Successfylly and save D Folder "

End Sub

Function NUM_TO_IND_RUPEE_WORD(ByVal MyNumber, Optional incRupees As Boolean = True)
Dim Crores, Lakhs, Rupees, Paise, Temp
Dim DecimalPlace As Long, Count As Long
Dim myLakhs, myCrores
ReDim Place(9) As String
Place(2) = " Thousand ": Place(3) = " Million "
Place(4) = " Billion ": Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert Paise and set MyNumber to Rupees amount.
If DecimalPlace > 0 Then
Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
myCrores = MyNumber \ 10000000
myLakhs = (MyNumber - myCrores * 10000000) \ 100000
MyNumber = MyNumber - myCrores * 10000000 - myLakhs * 100000
Count = 1
Do While myCrores <> ""
Temp = GetHundreds(Right(myCrores, 3))
If Temp <> "" Then Crores = Temp & Place(Count) & Crores
If Len(myCrores) > 3 Then
myCrores = Left(myCrores, Len(myCrores) - 3)
Else
myCrores = ""
End If
Count = Count + 1
Loop
Count = 1
Do While myLakhs <> ""
Temp = GetHundreds(Right(myLakhs, 3))
If Temp <> "" Then Lakhs = Temp & Place(Count) & Lakhs
If Len(myLakhs) > 3 Then
myLakhs = Left(myLakhs, Len(myLakhs) - 3)
Else
myLakhs = ""
End If
Count = Count + 1
Loop
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Crores
Case "": Crores = ""
Case "One": Crores = " One Crore "
Case Else: Crores = Crores & " Crores "
End Select
Select Case Lakhs
Case "": Lakhs = ""
Case "One": Lakhs = " One Lakh "
Case Else: Lakhs = Lakhs & " Lakhs "
End Select
Select Case Rupees
Case "": Rupees = "Zero "
Case "One": Rupees = "One "
Case Else:

Rupees = Rupees
End Select
Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and Paise " & Paise & " Only "
End Select
NUM_TO_IND_RUPEE_WORD = IIf(incRupees, "Rupees ", "") & Crores & _
Lakhs & Rupees & Paise
End Function

' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function

Sub formating()
ActiveWindow.SmallScroll Down:=3
    Range("A11:N17").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWindow.SmallScroll Down:=9
    Range("A18:N21").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A22:N23").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWindow.SmallScroll Down:=-15
    Range("H4:I21").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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    ActiveWindow.SmallScroll Down:=0
    Range("A4:N10").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    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
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("L8").Select
    ActiveWindow.SmallScroll Down:=15
    Sheets("sheet1").Range("a24:o1000").Select
    ActiveCell.ClearContents
        
    Range("A25:O486").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B25").Select
    
    ActiveWorkbook.Close False
    
    
End Sub

NOTE - You can insert three sheets as per above mention  and write code .

--Posted By : santosh