Copy Data into Different Sheets

Hi Experts,

I would like to request Experts help create a macro to copy and paste data from Validation2 sheet into Matched and Missing sheet. If Data at Column Status with “Yes”, data at column Number and Type need to be copied at Matched sheet. If Data at Column Status with “No”, data at Column Number and Type need to be copied at Missing sheet. I have manually copied few sample data at Matched and Missing sheet for Experts to get better view. Hope Experts will help create this feature. Attached the workbook for Experts perusal.



CopyData.xls
CartilloAsked:
Who is Participating?
 
SiddharthRoutConnect With a Mentor Commented:
Sorry for taking so Long. I had to create the sample data which could span multiple columns.

Try this. I have tested it and it works. :)

Sub CopyData()
    Dim ws1LastRow As Long, ws2LastRow As Long, C As Long
    Dim ws1LastCol As Long, ws2LastCol As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    Set ws1 = Sheets("Matched")
    Set ws2 = Sheets("Missing")
    
    Application.ScreenUpdating = False
    
    ws1LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
    ws1LastCol = ws1.UsedRange.Columns.Count
    C = 0
    
    If ws1LastRow > 65536 Then
        ws1LastCol = ws1LastCol + 2
        
        ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, -1).Value = "Number"
        
        ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Value = "Type"
        
        ws1.Range("A1").Copy
        ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, -1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        ws1.Range("B1").Copy
        ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        C = C + 2
        ws1LastRow = ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        ws1.Cells(ws1LastRow, ws1LastCol).Value = aCell.Offset(, -1).Value
        ws1.Cells(ws1LastRow, ws1LastCol - 1).Value = aCell.Offset(, -2).Value
        ws1LastRow = ws1LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws1LastRow > 65536 Then
                    ws1LastCol = ws1LastCol + 2
                    
                    ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, -1).Value = "Number"
                    
                    ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Value = "Type"
                    
                    ws1.Range("A1").Copy
                    ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, -1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    
                    ws1.Range("B1").Copy
                    ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
                    C = C + 2
                    ws1LastRow = ws1.Range(Split(Cells(, Split(Cells(, ws1LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                ws1.Cells(ws1LastRow, ws1LastCol).Value = aCell.Offset(, -1).Value
                ws1.Cells(ws1LastRow, ws1LastCol - 1).Value = aCell.Offset(, -2).Value
                ws1LastRow = ws1LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    ws2LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Rows.Count + 1
    ws2LastCol = ws2.UsedRange.Columns.Count
    C = 0
    
    If ws2LastRow > 65536 Then
        ws2LastCol = ws2LastCol + 2
        
        ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, -1).Value = "Number"
        
        ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Value = "Type"
        
        ws2.Range("A1").Copy
        ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, -1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        ws2.Range("B1").Copy
        ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        C = C + 2
        ws2LastRow = ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        ws2.Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
        ws2.Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
        ws2LastRow = ws2LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws2LastRow > 65536 Then
                    ws2LastCol = ws2LastCol + 2
                    
                    ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, -1).Value = "Number"
                    
                    ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Value = "Type"
                    
                    ws2.Range("A1").Copy
                    ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, -1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    
                    ws2.Range("B1").Copy
                    ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
                    C = C + 2
                    ws2LastRow = ws2.Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                ws2.Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
                ws2.Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
                ws2LastRow = ws2LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If

    MsgBox "done"
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
SiddharthRoutCommented:
Try this. Sample Attached.

Please run the Sub Sample in Module 5

Sid

Code Used

Sub CopyData()
    Dim ws1LastRow As Long
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    ws1LastRow = Sheets("Validation2").UsedRange.Rows.Count
    
    Sheets("Validation2").Rows("2:" & ws1LastRow).Copy
    Sheets("Matched").Activate
    Rows(2).Select
    ActiveSheet.Paste
    
    Sheets("Validation2").Rows("2:" & ws1LastRow).Copy
    Sheets("Missing").Activate
    Rows(2).Select
    ActiveSheet.Paste
    
    Set aCell = Sheets("Matched").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        aCell.ClearContents
        aCell.Offset(, -1).ClearContents
        aCell.Offset(, -2).ClearContents
        Do While ExitLoop = False
            Set aCell = Sheets("Matched").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                aCell.ClearContents
                aCell.Offset(, -1).ClearContents
                aCell.Offset(, -2).ClearContents
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    Set aCell = Sheets("Missing").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
    If Not aCell Is Nothing Then
        Set bCell = aCell
        aCell.ClearContents
        aCell.Offset(, -1).ClearContents
        aCell.Offset(, -2).ClearContents
        Do While ExitLoop = False
            Set aCell = Sheets("Missing").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                aCell.ClearContents
                aCell.Offset(, -1).ClearContents
                aCell.Offset(, -2).ClearContents
            Else
                ExitLoop = True
            End If
        Loop
    End If
End Sub

Open in new window

CopyData.xls
0
 
CartilloAuthor Commented:
Hi Sid,

Thanks. Is that possible to omit Yes and No at Matched and Missing sheet. Sufficient with Number and Type. Also prevent blank rows between (back to back). Hope you will consider this request.
0
Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

 
SiddharthRoutCommented:
Sure not a problem.

Is it ok if I give you that data in just one column?

Sid
0
 
CartilloAuthor Commented:
Hi Sid,

I got more than 500,000 data (in my actual data and the Data will grow ever bigger in the future). Is that possible to arrange the data until 45,000 rows and starts the new rows subsequently. E.g. starts first data at A2 until A65,000, than new data row continues at C2 and the loop go on until the whole data have copied.
0
 
SiddharthRoutCommented:
Sure...

Gimme me a moment.

Sid
0
 
SiddharthRoutCommented:
Try this Sample File. I haven't tested it. If you find any errors let me know. Please run the Sub CopyData()

Sid

Code Used

Sub CopyData()
    Dim ws2LastRow As Long, ws3LastRow As Long
    Dim ws2LastCol As Long, ws3LastCol As Long
    
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    ws2LastRow = Sheets("Matched").Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LastCol = Sheets("Matched").UsedRange.Columns.Count
    
    If ws2LastRow > 65536 Then
        ws2LastCol = ws2LastCol + 1
        ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    Set aCell = Sheets("Validation2").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
        ws2LastRow = ws2LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws2LastRow > 65536 Then
                    ws2LastCol = ws2LastCol + 1
                    ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
                ws2LastRow = ws2LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    ws3LastRow = Sheets("Missing").Range("A" & Rows.Count).End(xlUp).Rows.Count + 1
    ws3LastCol = Sheets("Missing").UsedRange.Columns.Count
    
    If ws3LastRow > 65536 Then
        ws3LastCol = ws3LastCol + 1
        ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
        ws3LastRow = ws3LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws3LastRow > 65536 Then
                    ws3LastCol = ws3LastCol + 1
                    ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
                ws3LastRow = ws3LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
End Sub

Open in new window

CopyData.xls
0
 
CartilloAuthor Commented:
Hi Sid,
Sorry for the late reply. Thanks for the revised code. Can we add number as well in the Matched and Missing sheets besides Type?
0
 
SiddharthRoutCommented:
>> Can we add number as well in the Matched and Missing sheets besides Type?

Sample Attached.

Sid

Code Used

Sub CopyData()
    Dim ws2LastRow As Long, ws3LastRow As Long
    Dim ws2LastCol As Long, ws3LastCol As Long
    
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    ws2LastRow = Sheets("Matched").Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LastCol = Sheets("Matched").UsedRange.Columns.Count
    
    If ws2LastRow > 65536 Then
        ws2LastCol = ws2LastCol + 1
        ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    Set aCell = Sheets("Validation2").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
        ws2LastRow = ws2LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws2LastRow > 65536 Then
                    ws2LastCol = ws2LastCol + 1
                    ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
                ws2LastRow = ws2LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    ws3LastRow = Sheets("Missing").Range("A" & Rows.Count).End(xlUp).Rows.Count + 1
    ws3LastCol = Sheets("Missing").UsedRange.Columns.Count
    
    If ws3LastRow > 65536 Then
        ws3LastCol = ws3LastCol + 1
        ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
        ws3LastRow = ws3LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws3LastRow > 65536 Then
                    ws3LastCol = ws3LastCol + 1
                    ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
                ws3LastRow = ws3LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
End Sub

Open in new window

CopyData.xls
0
 
CartilloAuthor Commented:
Hi Sid,

Attached the sample result that I got after running the code. The Number and Type data were not copied properly, especially after its exceeded 65,000 rows. Hope you could help me to fix this.
CopyData5.xls
0
 
SiddharthRoutCommented:
I just checked it. It has copied correctly. Am I missing something?

Sid
0
 
CartilloAuthor Commented:
Hi Sid,

It works perfectly until it's reached 65,536, after this rows the Type data has been missing.
0
 
SiddharthRoutCommented:
Can you share the original data that you are testing with?

Sid
0
 
CartilloAuthor Commented:
Hi Sid,

I'm only able to push the end result after crosschecking all the data (which is 2,285,016 data at Validation 2). I have removed most of the data at Data and Validation2 sheets to allow upload the file. The original file (all data) is really big. Hope it helps.
CopyData3.zip
0
 
CartilloAuthor Commented:
Hi Sid,

Please let me know if the supplied data is not suitable for test. Hope you'll this request.
0
 
SiddharthRoutCommented:
Cartillo: Since the data is less, I had to copy paste it many time and when I ran it, I didn't get any error as such. Are you getting any errors? If yes, then what is the error?

Sid
0
 
SiddharthRoutCommented:
I found the error. Try this.

Sub CopyData()
    Dim ws2LastRow As Long, ws3LastRow As Long
    Dim ws2LastCol As Long, ws3LastCol As Long
    
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    ws2LastRow = Sheets("Matched").Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LastCol = Sheets("Matched").UsedRange.Columns.Count
    
    If ws2LastRow > 65536 Then
        ws2LastCol = ws2LastCol + 2
        ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    Set aCell = Sheets("Validation2").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
        ws2LastRow = ws2LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws2LastRow > 65536 Then
                    ws2LastCol = ws2LastCol + 2
                    ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
                ws2LastRow = ws2LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    ws3LastRow = Sheets("Missing").Range("A" & Rows.Count).End(xlUp).Rows.Count + 1
    ws3LastCol = Sheets("Missing").UsedRange.Columns.Count

    If ws3LastRow > 65536 Then
        ws3LastCol = ws3LastCol + 2
        ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
        ws3LastRow = ws3LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws3LastRow > 65536 Then
                    ws3LastCol = ws3LastCol + 2
                    ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
                ws3LastRow = ws3LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
End Sub

Open in new window


Sid
0
 
CartilloAuthor Commented:
Hi Sid,

Cool! It works perfectly. Need one more favor. Is that possible to labeled the header, “task” and “number” automatically being  created as and when a new columns are created for “Matched” and “Missing” sheet? Hope you will consider this request.
0
 
SiddharthRoutCommented:
Sure few minutes
Sid
0
 
SiddharthRoutCommented:
Try this

Sub CopyData()
    Dim ws2LastRow As Long, ws3LastRow As Long
    Dim ws2LastCol As Long, ws3LastCol As Long
    
    Dim aCell As Range
    Dim ExitLoop As Boolean
    
    ws2LastRow = Sheets("Matched").Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LastCol = Sheets("Matched").UsedRange.Columns.Count
    
    If ws2LastRow > 65536 Then
        ws2LastCol = ws2LastCol + 2
        
        Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 1).Value = "Number"
        
        Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 2).Value = "Type"
        
        Sheets("Matched").Range("A1").Copy
        Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        Sheets("Matched").Range("B1").Copy
        Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        
        ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    Set aCell = Sheets("Validation2").Cells.Find(What:="Yes", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
        ws2LastRow = ws2LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws2LastRow > 65536 Then
                    ws2LastCol = ws2LastCol + 2
                    
                    Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 1).Value = "Number"
                    
                    Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 2).Value = "Type"
                    
                    Sheets("Matched").Range("A1").Copy
                    Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    
                    Sheets("Matched").Range("B1").Copy
                    Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
        
                    ws2LastRow = Sheets("Matched").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Matched").Cells(ws2LastRow, ws2LastCol - 1).Value = aCell.Offset(, -2).Value
                ws2LastRow = ws2LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ExitLoop = False
    
    ws3LastRow = Sheets("Missing").Range("A" & Rows.Count).End(xlUp).Rows.Count + 1
    ws3LastCol = Sheets("Missing").UsedRange.Columns.Count
    
    If ws3LastRow > 65536 Then
        ws3LastCol = ws3LastCol + 2
        
        Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 1).Value = "Number"
        
        Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 2).Value = "Type"
        
        Sheets("Missing").Range("A1").Copy
        Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        Sheets("Missing").Range("B1").Copy
        Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
        "$")(1)).Address, "$")(1) & 1).Offset(, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        
        ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
        "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
    End If
    
    Set aCell = Sheets("Validation2").Cells.Find(What:="No", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    Debug.Print ws3LastRow & ", " & ws3LastCol
    'Exit Sub
    If Not aCell Is Nothing Then
        Set bCell = aCell
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
        Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
        ws3LastRow = ws3LastRow + 1
        Do While ExitLoop = False
            Set aCell = Sheets("Validation2").Cells.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If ws3LastRow > 65536 Then
                    ws3LastCol = ws3LastCol + 2
                    
                    Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 1).Value = "Number"
                    
                    Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 2).Value = "Type"
                    
                    Sheets("Missing").Range("A1").Copy
                    Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    
                    Sheets("Missing").Range("B1").Copy
                    Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws2LastCol).Address, _
                    "$")(1)).Address, "$")(1) & 1).Offset(, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
        
                    ws3LastRow = Sheets("Missing").Range(Split(Cells(, Split(Cells(, ws3LastCol).Address, _
                    "$")(1)).Address, "$")(1) & Rows.Count).End(xlUp).Rows.Count + 1
                End If
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol).Value = aCell.Offset(, -1).Value
                Sheets("Missing").Cells(ws3LastRow, ws3LastCol - 1).Value = aCell.Offset(, -2).Value
                ws3LastRow = ws3LastRow + 1
            Else
                ExitLoop = True
            End If
        Loop
    End If
End Sub

Open in new window

0
 
CartilloAuthor Commented:
Hi Sid,

Thanks for the script. The Number and Type are copied at column A,B and C,D but stopped there. New columns after these no logger carries these headers. Please advice.  
0
 
CartilloAuthor Commented:
Hi Sid,

Thanks a lot. Is that any possible to copy the data whilst the “Status” sheers are hidden?
0
 
SiddharthRoutCommented:
There is no status sheet in the file?

Sid
0
 
CartilloAuthor Commented:
Hi Sid,

Sorry just ignore this Q, it's suppose to be Column. Managed to fix that actually. Sorry  
0
 
CartilloAuthor Commented:
Hi Sid,

Thanks a lot for the great help.
0
All Courses

From novice to tech pro — start learning today.