Solved

Copy Data into Different Sheets

Posted on 2011-02-25
25
218 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:Cartillo
  • 13
  • 12
25 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34985933
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
 

Author Comment

by:Cartillo
ID: 34985973
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34985979
Sure not a problem.

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

Sid
0
 

Author Comment

by:Cartillo
ID: 34986000
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34986003
Sure...

Gimme me a moment.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34986050
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
 

Author Comment

by:Cartillo
ID: 34987505
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34987570
>> 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
 

Author Comment

by:Cartillo
ID: 34988104
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34991624
I just checked it. It has copied correctly. Am I missing something?

Sid
0
 

Author Comment

by:Cartillo
ID: 34991739
Hi Sid,

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

Expert Comment

by:SiddharthRout
ID: 34991816
Can you share the original data that you are testing with?

Sid
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:Cartillo
ID: 34991953
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
 

Author Comment

by:Cartillo
ID: 34998024
Hi Sid,

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

Expert Comment

by:SiddharthRout
ID: 35003525
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35003606
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
 

Author Comment

by:Cartillo
ID: 35003976
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35003987
Sure few minutes
Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35004056
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
 

Author Comment

by:Cartillo
ID: 35004268
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
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 35004416
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
 

Author Comment

by:Cartillo
ID: 35005063
Hi Sid,

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

Expert Comment

by:SiddharthRout
ID: 35007997
There is no status sheet in the file?

Sid
0
 

Author Comment

by:Cartillo
ID: 35008750
Hi Sid,

Sorry just ignore this Q, it's suppose to be Column. Managed to fix that actually. Sorry  
0
 

Author Closing Comment

by:Cartillo
ID: 35008765
Hi Sid,

Thanks a lot for the great help.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now