Results 1 to 5 of 5

Copy number of rows based on cell value

Threaded View

  1. #1
    Registered User
    Join Date
    02-21-2010
    Location
    UK
    MS-Off Ver
    Excel 2003
    Posts
    40

    Smile 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
    Last edited by Leith Ross; 03-20-2011 at 01:25 PM. Reason: Changed Quote Tags to Code Tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1