Code to copy several rows from one sheet to another in Excel

Question

First, thanks for reading and any help offered.

I'm basically clueless here. I've spent the last several days trying to figure out how to code what I'd like done, and I'll try to explain it clearly.

My workbook has multiple sheets, but only two of them are of interest regarding this: Schedule & Shift.

On Schedule, there are 17 columns and 40-100 rows containing the employees name (column A) in one column, their initials (B), their employee number (C), their shift (D) and shift hours (E - which is returned via vlookup to another sheet).

Basically, I want a button that will copy the data from each of those 5 columns to the Shift sheet starting at "A3" and continue to copy down the rows in Schedule until it reaches a blank field for their name (which is column A).

So far, I've managed to copy the first row and the second row with the following code:

    Private Sub CommandButton1_Click()
Dim i As Integer, IntName As String, IntInit As String, IntID As Integer, Shift As String, Hours As Integer
    Worksheets("Schedule").Select
    i = 1
    IntName = Range("a4")
    IntInit = Range("b4")
    IntID = Range("C4")
    Shift = Range("D4")
    Hours = Range("E4")

    Do While i < 5

    Worksheets("Shift").Select
    Worksheets("Shift").Range("a2").Select

    If Worksheets("Shift").Range("a2").Offset(1, 0) <> "" Then
    Worksheets("Shift").Range("a2").End(xlDown).Select
    End If

    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = IntName
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = IntInit
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = IntID
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Shift
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Hours
    Worksheets("Schedule").Select

    IntName = Worksheets("Schedule").Range("a4").Offset(1, 0)
    IntInit = Worksheets("Schedule").Range("b4").Offset(1, 0)
    IntID = Worksheets("Schedule").Range("c4").Offset(1, 0)
    Shift = Worksheets("Schedule").Range("d4").Offset(1, 0)
    Hours = Worksheets("Schedule").Range("e4").Offset(1, 0)

    i = i + 1

    Loop



End Sub

Obviously, this is clunky, and it doesn't actually do what I want beyond the 2nd time through the loop.

Any suggestions or pointers to help me move in the right direction?

Thanks again.

A quick note, I **highly** recommend reading through [How to avoid using `.Select`](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). It can save many headaches, and can really help your understanding with loops. — BruceWayne, Mar 29 '16 at 19:00

score 0 · Answer 1 · answered Mar 29 '16 at 19:09

You're on the right path, you just need to nest our loop in another loop. Also, heed @BruceWayne's advice.

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim intCounter As Integer
    Dim IntName As String
    Dim IntInit As String
    Dim IntID As Integer
    Dim Shift As String
    Dim Hours As Integer

    'Adjust intCounter if you want to start on a row other than 1
    intCounter = 1

    Do
        With Worksheets("Schedule")
            IntName = .Cells(intCounter, 1).Value
            IntInit = .Cells(intCounter, 2).Value
            IntID = .Cells(intCounter, 3).Value
            Shift = .Cells(intCounter, 4).Value
            Hours = .Cells(intCounter, 5).Value
        End With

        If IntName = "" Then Exit Do

        i = 1
        Do While i < 5
            'No need to use offset when you can just reference the cell directly.
            'Also, not sure why you select this column anyhow.
            'These lines can probably be deleted?
            'If Worksheets("Shift").Range("a3").Value <> "" Then
            '    Worksheets("Shift").Range("a2").End(xlDown).Select
            'End If

            'Avoid using things like Select, ActiveCell, and ActiveSheet.
            'What if someone clicks on something while your code is running?? Oops!
            With Worksheets("Shift")
                .Cells(i + 1, 2).Value = IntName
                .Cells(i + 1, 3).Value = IntInit
                .Cells(i + 1, 4).Value = IntID
                .Cells(i + 1, 5).Value = Shift
                .Cells(i + 1, 6).Value = Hours
            End With

            i = i + 1
        Loop

        'Increment to go to the next row of Schedule
        intCounter = intCounter + 1
    Loop
End Sub

You're right. I missed it since only looked at "Do" and "Loop" statements. Anyhow I'd take it as a good habit to always keep end condition in one of those two statements. — user3598756, Mar 30 '16 at 05:18
In general I would agree since another person reviewing your code may not read it in its entirety. It really should have been commented in the code. :/ In this case however, `Do While intName <> ""` forces a duplicate block of code to load the variables. `Do ... Loop While intName <> ""` ends up copying a blank row. `Do ... If IntName = "" Then Exit Do ... Loop` ensures no blank rows are copied and the code remains compact. — Tim, Mar 30 '16 at 14:02

score 0 · Answer 2 · answered Mar 30 '16 at 14:42

brought in by Tim's concern about compact code, try this

Private Sub CommandButton1_Click()

With Worksheets("Schedule").Range("A4:E4").CurrentRegion
    .Offset(1).Resize(.Rows.Count - 1).Copy Destination:=Worksheets("Shift").Range("A3")
End With

End Sub

Code to copy several rows from one sheet to another in Excel

2 Answers2