Copy number of rows based on cell value

Hey all,

I have the following VBA code which copies a range from a particular sheet and pastes the data to the last available row in another master sheet (database). The problem is I want to copy the number of rows based on a cell value in one of my sheets.

For example, if my number is "2" I only want to copy the first 2 rows (range B2 to R3), if this number displays "3" I want it to copy the 3 rows (range B2 to R4) etc.

The below code means I am just pasting all of my maximum 4 rows across to the database when some of these fields are blank.

Sub SaveForm()

    Worksheets("Main").Activate          

    With Application
           .ScreenUpdating = False
           .EnableEvents = False
    End With
    
    
                Dim dataBaselocation As String
                dataBaselocation = Worksheets("Database Location").Range("B3").Value

    
' Copy data and submit to database

                                           
                                'copy data from Data form
                                
                                Worksheets("Data").Visible = True
                                Worksheets("Data").Activate
                                
                                'Range("BT3").Value = decisionDate
                                Range("B2:R5").Select
                                Selection.Copy
                                
                                'opening Workbook
                                Application.Workbooks.Open (dataBaselocation)
                                
                                'Make the Data sheet visible and activate it
                                Worksheets("Sheet1").Visible = True
                                Worksheets("Sheet1").Activate
                                
                                'Identify the last row and select cell to paste from
                                lastrow1 = Range("C1:C10000").End(xlDown).Row + 1
                                Range("A" & lastrow1).Select
                                
                                ' paste data to the next available row
                                Selection.PasteSpecial Paste:=xlPasteValues
                                
                                'Save file and close
                                ActiveWorkbook.Save
                                ActiveWorkbook.Close
                                
                                
                                'close file
                                ActiveWorkbook.Close

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

Hello DaveNUFC
,
Which cell on which worksheet of which workbook is this value to be found?

Hello DaveNUFC,

If I understand you correctly then this should work.

Sub SaveForm()

    Worksheets("Main").Activate          

    With Application
           .ScreenUpdating = False
           .EnableEvents = False
    End With
    
    
                Dim dataBaselocation As String
                dataBaselocation = Worksheets("Database Location").Range("B3").Value

    
' Copy data and submit to database

                                           
                                'copy data from Data form
                                
                                Worksheets("Data").Visible = True
                                Worksheets("Data").Activate
                                
                                Range("B2:R2").Resize(RowSize:=Range("B53").Value).Copy
                                
                                'opening Workbook
                                Application.Workbooks.Open (dataBaselocation)
                                
                                'Make the Data sheet visible and activate it
                                Worksheets("Sheet1").Visible = True
                                Worksheets("Sheet1").Activate
                                
                                'Identify the last row and select cell to paste from
                                lastrow1 = Range("C1:C10000").End(xlDown).Row + 1
                                Range("A" & lastrow1).Select
                                
                                ' paste data to the next available row
                                Selection.PasteSpecial Paste:=xlPasteValues
                                
                                'Save file and close
                                ActiveWorkbook.Save
                                ActiveWorkbook.Close
                                
                                
                                'close file
                                ActiveWorkbook.Close

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