VBA Issue

[hkittaneh]

Hello experts

i have created a receipt voucher form and in order to make it a systemized for i copied a macro , & assigned it to a button. the problem is when data is being copied from the form to the master sheet, it's coming in many rows ( as per the photo) while i want every receipt voucher data to come in one row.

FYI , the macro is written below:

Sub Button2_Click()

Dim rng As Range
Dim temp As Variant
Dim i As Long
Dim a As Long
Dim rng_dest As Range

Application.ScreenUpdating = False

i = 1

Set rng_dest = Sheets("RV DATA BASE").Range("A:H")

' Find first empty row in columns A:H on sheet RV DATA BASE

Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0

i = i + 1

Loop

'Copy range B16:I38 on sheet Invoice to Variant array

Set rng = Sheets("FORM").Range("C:G")

' Copy rows containing values to sheet RV DATA BASE

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("RV DATA BASE").Range("A" & i).Value = Sheets("FORM").Range("G3").Value

'Copy Date

Sheets("RV DATA BASE").Range("B" & i).Value = Sheets("FORM").Range("G6").Value

'Copy Company name

Sheets("RV DATA BASE").Range("C" & i).Value = Sheets("FORM").Range("C3").Value
Sheets("RV DATA BASE").Range("D" & i).Value = Sheets("FORM").Range("C4").Value

'Copy Amount
Sheets("RV DATA BASE").Range("E" & i).Value = Sheets("FORM").Range("C10").Value

'Copy Remarks
Sheets("RV DATA BASE").Range("F" & i).Value = Sheets("FORM").Range("C17").Value

'Copy Payment Type
Sheets("RV DATA BASE").Range("G" & i).Value = Sheets("FORM").Range("C14").Value

'Copy Bank
Sheets("RV DATA BASE").Range("H" & i).Value = Sheets("FORM").Range("F10").Value


i = i + 1


End If

Next a

Application.ScreenUpdating = True


End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
Range("E19").Select
Selection.Copy
Sheets("RV DATA BASE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

 

[Legacy 143009]

Because you are inserting in a while loop. Just do it once:

Sub Button2_Click()
  Dim lRow As Long
  With Worksheets("RV DATA BASE")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  .Cells(lRow, 1).Value = Worksheets("FORM").Range("G3").Value
  .Cells(lRow, 2).Value = Worksheets("FORM").Range("G6").Value
  .Cells(lRow, 3).Value = Worksheets("FORM").Range("C3").Value
  .Cells(lRow, 4).Value = Worksheets("FORM").Range("C4").Value
  .Cells(lRow, 5).Value = Worksheets("FORM").Range("C10").Value
  .Cells(lRow, 6).Value = Worksheets("FORM").Range("C17").Value
  .Cells(lRow, 7).Value = Worksheets("FORM").Range("C14").Value
  .Cells(lRow, 6).Value = Worksheets("FORM").Range("F10").Value
  End With
End Sub