Data Copied Excess in columns

Dear experts

I am newbie here, i have a excel workbook contains two sheets & i have code
i cant explain hence please see attached workbook.
if my "Material in" sheet data has upto 3 coulmns, then remain data should be copied upto 3 rows , but it copied upto 40 rows

  Dim rng As Range
  Dim temp As Variant
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range
  i = 1
  Set rng_dest = Sheets("Material In").Range("A:C")
  'Find first empty row in columns D:J on sheet Invoice data
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range B16:I34 on sheet Invoice to Variant array
  Set rng = Sheets("Voucher Material Inward").Range("D7:F50")
  For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy Invoice number
      Sheets("Material In").Range("F" & i).Value = Sheets("Voucher Material Inward").Range("C5").Value
      'Copy invoice Date
      Sheets("Material In").Range("G" & i).Value = Sheets("Voucher Material Inward").Range("E5").Value
      'Copy Company name
      Sheets("Material In").Range("E" & i).Value = Sheets("Voucher Material Inward").Range("C4").Value
      'Receipt Date
      Sheets("Material In").Range("D" & i).Value = Sheets("Voucher Material Inward").Range("C3").Value
      'Site Name
      Sheets("Material In").Range("H" & i).Value = Sheets("Voucher Material Inward").Range("E3").Value
      i = i + 1
    End If
  Next a
End Sub

Please help me Thanks in advance

Your help would be highly appreciated.

Thanks
Sagar007