Copy a row from one sheet to another using VBA

Question

I have two sheets containing the employee records. Sheet1 contains the Event Date, CardNo, Employee Name, Dept Id, Employee No, Entry and Exit Time, Total Working Hours, Status, ConcatinatedColumn and Remarks (copied through vlookup from sheet2)

Sheet2 contains ConcatinatedColumn, Event Date, Employee No, Name, Remarks.

If the data in the remarks column of sheet2 is "Sick Off" then that row should be inserted to sheet1 without effecting the previous records.

I've already written the code for it but it does not work.

Would be really grateful if anyone can help me out !

THANKS IN ADVANCE !

MY CODE :

Sub SickOff()

Dim objWorksheet As Sheet2
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String

'Used for the new worksheet we are pasting into
Dim objNewSheet As Sheet1

Dim rngNextAvailbleRow As Range

'Define the worksheet with our data
Set objWorksheet = ThisWorkbook.Worksheets("Sheet2")


'Dynamically define the range to the last cell.
'This doesn't include and error handling e.g. null cells
'If we are not starting in A1, then change as appropriate
Set rngBurnDown = objWorksheet.Range("G2:G" & objWorksheet.Cells(Rows.Count,       "G").End(xlUp).Row)

'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells

objWorksheet.Select

If rngCell.Value = "Sick Off" Then
'select the entire row
rngCell.EntireRow.Select

'copy the selection
Selection.Copy

'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Sheet1" & rngCell.Value)
objNewSheet.Select

'Looking at your initial question, I believe you are trying to find the next     available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)


Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If

Next rngCell

objWorksheet.Select
objWorksheet.Cells(1, 1).Select

'Can do some basic error handing here

'kill all objects
If IsObject(objWorksheet) Then Set objWorksheet = Nothing
If IsObject(rngBurnDown) Then Set rngBurnDown = Nothing
If IsObject(rngCell) Then Set rngCell = Nothing
If IsObject(objNewSheet) Then Set objNewSheet = Nothing
If IsObject(rngNextAvailbleRow) Then Set rngNextAvailbleRow = Nothing

End Sub

If the data in the remarks column of sheet2 is "Sick Off" then that row should be inserted to sheet1 without effecting the previous records. Inserting the row is not a problem but then both the sheets have headers in different location. Wouldn't that be a problem? — Siddharth Rout
Yes it would be.. but as of now i'm not able to figure out copy-pasting the row also.. Do you know how to get the rows according to their specific headers? Would be great if you can help me out.. Please ! — Faaria Mariam
May I see a sample of the workbook? If yes then can you upload the same in www.wikisend.com and share the link here? — Siddharth Rout
Yes sure, Download Link - wikisend.com/download/454684/AccessCardReport_November.xlsx — Faaria Mariam

Siddharth Rout Siddharth Rout · Accepted Answer · 2013-12-11T08:21:11

Let's say you have data in Sheet2 as shown below

enter image description here

Let's say the end of data in Sheet1 looks like this

enter image description here

Logic:

We are using autofilter to get the relevant range in Sheet2 which match Sick Off in Col G. Once we get that, we copy the data to the last row in Sheet1. After the data is copied, we simply shuffle data across to match the column headers. As you mentioned that the headers won't change so we can take the liberty of hardcoding the column names for shuffling this data.

Code:

Paste this code in a module

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow As Long, wsOlRow As Long, OutputRow As Long
    Dim copyfrom As Range

    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    '~~> This is the row where the data will be written
    OutputRow = wsI.Range("A" & wsI.Rows.Count).End(xlUp).Row + 1

    With wsO
        wsOlRow = .Range("G" & .Rows.Count).End(xlUp).Row

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter G on "Sick Off"
        With .Range("G1:G" & wsOlRow)
            .AutoFilter Field:=1, Criteria1:="=Sick Off"
            Set copyfrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    If Not copyfrom Is Nothing Then
        copyfrom.Copy wsI.Rows(OutputRow)

        '~~> Shuffle data
        With wsI
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row

            .Range("A" & OutputRow & ":A" & lRow).Delete Shift:=xlToLeft
            .Range("F" & OutputRow & ":F" & lRow).Copy .Range("K" & OutputRow)
            .Range("F" & OutputRow & ":F" & lRow).ClearContents
            .Range("B" & OutputRow & ":B" & lRow).Copy .Range("E" & OutputRow)
            .Range("B" & OutputRow & ":B" & lRow).ClearContents
        End With
    End If
End Sub

Output:

enter image description here

Copy a row from one sheet to another using VBA

1 Answers