Macro to copy from Row 2 to last row in a range from one sheet to the next empty row in another sheet

[chappy]

I am transferring a data range from a source sheet "DAS_DATA" to a destination sheet "JOURNAL".
The data range from the source sheet changes for each transfer. It could be just two rows but sometimes could be several hundred.
The starting row of this range is fixed ( row 2). Row one is a header row containing labels which should not be copied.
The columns in the range are always fixed (columns A to Y).

I have written code that does work but I don't believe that it is the most efficient method to copy the data across. It copies across one source data row at a time in a loop.

I think it I would be better to define the data to be copied and pasted as a range from row 2 the source sheet to the last used row on the source sheet sheet, columns A to Y.

Then that data range should be pasted to the next available row in the destination sheet.

If anyone can advise me or point assist in making my existing code more efficient it would be very much appreciated.

Below is the existing code:

Private Sub copyToHistorySheet()

Dim sourceSheet As Worksheet 'Source Sheet'
Dim destSheet   As Worksheet 'Destination Sheet'

Dim destLastRow As Integer 'Last Row of Destination'

Dim sourceRow As Range 'Source current row'


Set sourceSheet = ActiveWorkbook.Sheets("DAS_DATA")
Set destSheet = ActiveWorkbook.Sheets("JOURNAL")

'LastRow = destSheet.UsedRange.Rows(destSheet.UsedRange.Rows.Count).row'
LastRow = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).row
destSheet.Activate

destSheet.Range(Cells(LastRow, 1), Cells(LastRow, 25)).Select
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
            

For Each sourceRow In sourceSheet.UsedRange.Rows

If (sourceRow.row <> 1) Then
LastRow = LastRow + 1
sourceSheet.Range("A" & sourceRow.row, "Y" & sourceRow.row).Copy
'.Range("A" & sourceRow.row, "Z" & sourceRow.row).Copy'
destSheet.Range("A" & LastRow).PasteSpecial xlPasteAll
destSheet.Range("A" & LastRow).PasteSpecial xlPasteColumnWidths
End If

Next sourceRow

End Sub

 

[steve the fish]

Just tweaking what you already have:

Dim sourceSheet As Worksheet 'Source Sheet'
Dim destSheet   As Worksheet 'Destination Sheet'
Dim sourceLastRow As Long 'Last Row of Source'
Dim destLastRow As Long 'Last Row of Destination'

Set sourceSheet = ActiveWorkbook.Sheets("DAS_DATA")
Set destSheet = ActiveWorkbook.Sheets("JOURNAL")

sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
destLastRow = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row

With destSheet.Range(destSheet.Cells(destLastRow, 1), destSheet.Cells(destLastRow, 25))
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
End With

If sourceLastRow > 1 Then
    sourceSheet.Range("A2:Y" & sourceLastRow).Copy
    destSheet.Range("A" & destLastRow + 1).PasteSpecial xlPasteAll
    destSheet.Range("A" & destLastRow + 1).PasteSpecial xlPasteColumnWidths
End If

Application.CutCopyMode = False

 

[chappy]

Thanks steve the fish - that worked perfectly