0

I want to be able to press a button to copy some data across from sheet "Data Entry" to the first blank row in another sheet "Database".

However, if the first column is blank, I don't want that row of data to be copied. Also, sometimes the "Data Entry" sheet may have 4 rows of data, whilst sometimes it may have 5, 6, 7 or 8.

I've attached screenshots below.

The code I'm using so far is not giving any error, but nothing seems to be happening, either.

Private Sub CommandButton1_Click()

    Dim cl As Range    
    For Each cl In Sheet2.Range("A8:A23")

        If Not IsEmpty(ActiveCell.Value) Then

            Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Select
            Selection.Copy
            Sheets("Database").Select
            ActiveCell.End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste

        End If    
    Next cl
End Sub

image2 image3

CDspace
  • 2,639
  • 18
  • 30
  • 36
Seb Moran
  • 5
  • 2
  • Try and [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) as that can cause unexpected issues. If you step through the code with `F8`, does nothing happen? Does it skip any lines, etc? – BruceWayne Mar 07 '17 at 20:44

2 Answers2

0

Your current code is constantly referring to ActiveCell (which, after the first iteration [if it ever got that far], is a cell on the "Database" sheet!), not to the cells in range A8:A23 of Sheet2.

Refactored code could be:

Private Sub CommandButton1_Click()
    Dim cl As Range

    For Each cl In Sheet2.Range("A8:A23")
        If Not IsEmpty(cl.Value) Then
            With Worksheets("Database") ' to make it easier to refer to the sheet
                'Find last cell in column A, 
                ' go to the row below,
                ' extend the range to be 18 columns wide,
                ' set values to be values on Sheet2
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 18).Value = cl.Resize(1, 18).Value
            End With
        End If
    Next
End Sub
YowE3K
  • 23,852
  • 7
  • 26
  • 40
0

I'd do something simple like this. This may not be as efficient as some other methods, but it should do what you want it to. Also the range won't be hard coded and will change as the number of rows of data changes.

Dim lastRowDataEntry As Integer
Dim lastRowDatabase As Integer
Dim a As Integer

'Find the last row of data in each sheet
lastRowDataEntry = Sheets("Data Entry").Range("B" & Rows.Count).End(xlUp).Offset(0).Row


For a = 8 To lastRowDataEntry
    If IsEmplty(Sheets("Data Entry").Cells(a, "A").Value) = True Then GoTo ReadyForNexta
    Row(a).Select
    Selection.Copy
    lastRowDataBase = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(0).Row
    Sheets("Database").Cells(lastRowDatabase, "A").Select
    ActiveSheet.Paste

ReadyForNexta:

Next a
scsims
  • 17
  • 7