Seperate Highlighted Data into different sheet

[Pawan Sai]

Hi Everyone,
Good Afternoon

I'm Pawan Sai.
Can you please look into the query.

Problem: I have a data with different Columns which includes Blank Cells. So i Want to seperate Blank Cell Data into different sheet using Column Called "Login".
So, Please review and advice to paste the highlighted cells (Blank Cells) into different sheet.

Thank You.

 

[Belleke]

A starter.

Sub Belle()
Dim i As Long
    For i = Cells(Rows.Count, 12).End(xlUp).Row To 2 Step -1
        If Cells(i, 12) = "Review" Then
            Range("A" & i & ":AW" & i).Copy Sheets("Review Sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Cells(i, 12).EntireRow.Delete
        End If
    Next
End Sub

This code will move all the rows that contains Review in column L to the sheet named Review Sheet.
(you need to create the sheet named Review Sheet)

 

[Pawan Sai]

A starter.

Sub Belle()
Dim i As Long
    For i = Cells(Rows.Count, 12).End(xlUp).Row To 2 Step -1
        If Cells(i, 12) = "Review" Then
            Range("A" & i & ":AW" & i).Copy Sheets("Review Sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Cells(i, 12).EntireRow.Delete
        End If
    Next
End Sub

This code will move all the rows that contains Review in column L to the sheet named Review Sheet.
(you need to create the sheet named Review Sheet)

Hey Belleke,
Thanks for the help. But however, here still some fields are left out with blank cells which also it should get copied to another sheet..
Can you please review and help for the same...

 

[p45cal]

The column Login contains no blank cells.
Every row (2 to 43) contains a blank cell somewhere in your table; do you want to copy the whole table?

advice to paste the highlighted cells (Blank Cells) into different sheet

Pasting blank cells into another sheet will just result in a sheet full of blank cells; I'm not sure how useful that is.

 

[Pawan Sai]

The column Login contains no blank cells.
Every row (2 to 43) contains a blank cell somewhere in your table; do you want to copy the whole table?
Pasting blank cells into another sheet will just result in a sheet full of blank cells; I'm not sure how useful that is.

Yes, Actually This is the sample data i attached. So here we will get large number of data where need to find blank cells and copy to other sheet based upon column named "Login" (Coloumn C). So requesting to send a code for the data in which...Have to paste Blank cells data with Login Column..
Example :

Login

Exported ASIN Count

Exported ASIN count without canonical variation

Exported Brand Variation Count

No. of aliases identified

Total ASINs for redrive

Research Time (hours)

Research Completion Date

Bonsai Time (hours)

Bonsai Merge (Date)

Redrive Time (hours)

Redrive Submission (Date)

Review submite date

Review Phase End Date

DA Redrive Date

CRT redrive date

Redrive Status

Redrive Successful ASINs

Redrive Failed ASINs

Gatorade Time (hours)

Gatorade submission (Date)

Total Time (hours)

Redriev hours for multiple redrives

Submission date

Status of multiple redrives

Error codes

Redriev hours for multiple redrives

Submission date

Status of multiple redrives

Error codes

QC%

Date

Auditor login

QC Comments

Auditor's Time Taken

# total sample taken

# total TP's

QC 2

Date

Auditor login

QC Comments

Auditor's Time Taken

mohdanih

mahegorl

mahegorl

mahegorl

pnallara

pnallara

pnallara

pnallara

pnallara

Thank You...

 

[p45cal]

Try:

Sub blah()
Dim rngtoCopy As Range
Set SceSht = Sheets("Normalization Brand")
Set myRng = SceSht.Cells(1).CurrentRegion.Resize(, 49)
Set rngtoCopy = SceSht.Range("C1")
For rw = 2 To myRng.Rows.Count
  If Application.CountBlank(myRng.Rows(rw).Offset(, 6).Resize(, 43)) > 0 Then Set rngtoCopy = Union(rngtoCopy, myRng.Rows(rw).Cells(3))
Next rw
If Not rngtoCopy Is Nothing Then
  Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  Set Destn = newSht.Range("A1")
  For Each cll In rngtoCopy.Cells
    Destn.Value = cll.Value
    Destn.Offset(, 1).Resize(, 5).Value = cll.Offset(, 4).Resize(, 5).Value
    Destn.Offset(, 6).Resize(, 16).Value = cll.Offset(, 10).Resize(, 16).Value
    Destn.Offset(, 22).Resize(, 20).Value = cll.Offset(, 27).Resize(, 20).Value
    Set Destn = Destn.Offset(1)
  Next cll
End If
End Sub

 

[Pawan Sai]

Try:

Sub blah()
Dim rngtoCopy As Range
Set SceSht = Sheets("Normalization Brand")
Set myRng = SceSht.Cells(1).CurrentRegion.Resize(, 49)
Set rngtoCopy = SceSht.Range("C1")
For rw = 2 To myRng.Rows.Count
  If Application.CountBlank(myRng.Rows(rw).Offset(, 6).Resize(, 43)) > 0 Then Set rngtoCopy = Union(rngtoCopy, myRng.Rows(rw).Cells(3))
Next rw
If Not rngtoCopy Is Nothing Then
  Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  Set Destn = newSht.Range("A1")
  For Each cll In rngtoCopy.Cells
    Destn.Value = cll.Value
    Destn.Offset(, 1).Resize(, 5).Value = cll.Offset(, 4).Resize(, 5).Value
    Destn.Offset(, 6).Resize(, 16).Value = cll.Offset(, 10).Resize(, 16).Value
    Destn.Offset(, 22).Resize(, 20).Value = cll.Offset(, 27).Resize(, 20).Value
    Set Destn = Destn.Offset(1)
  Next cll
End If
End Sub

Thanks a Lot ...It worked...
I was really struggling since long back and it was sorted now by using above code..
Thanks Once Again

 

[p45cal]

looking again at the code it would be more sensible to change:

If Not rngtoCopy Is Nothing Then

to:

If rngtoCopy.cells.count>1 Then

so that if no blank is found at all, no new sheet is created.

 

[Pawan Sai]

Yeah making sense... Thanks a lot once again..