asked on

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

SiddharthRout

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

Cartillo

ASKER

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.

SiddharthRout

Sure not a problem.

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

Sid

Cartillo

ASKER

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.

SiddharthRout

Sure...

Gimme me a moment.

Sid

SiddharthRout

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

Cartillo

ASKER

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?

SiddharthRout

>> 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

Cartillo

ASKER

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

SiddharthRout

I just checked it. It has copied correctly. Am I missing something?

Sid

Cartillo

ASKER

Hi Sid,

It works perfectly until it's reached 65,536, after this rows the Type data has been missing.

SiddharthRout

Can you share the original data that you are testing with?

Sid

Cartillo

ASKER

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

Cartillo

ASKER

Hi Sid,

Please let me know if the supplied data is not suitable for test. Hope you'll this request.

SiddharthRout

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

SiddharthRout

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

Cartillo

ASKER

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.

SiddharthRout

Sure few minutes
Sid

SiddharthRout

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

Cartillo

ASKER

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.

ASKER CERTIFIED SOLUTION

SiddharthRout

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Cartillo

ASKER

Hi Sid,

Thanks a lot. Is that any possible to copy the data whilst the “Status” sheers are hidden?

SiddharthRout

There is no status sheet in the file?

Sid

Cartillo