Need Help - Macro - Moving data from main to new sheet -

[MKader]

Dear All,

Need your support - am trying to move data based on multiple criteria in 3 columns to be moved to another sheet,

Sheet header is located at A6 : AE6,

Criteria located in J6, N6 and O6,

Main Sheet name is "Raw" and the new sheet named "New",

Really appreciate your input,

Thanks,
MK

 

[vcoolio]

Hello MKader,

The following code may get you started:-

Sub CopyData()

Application.ScreenUpdating = False

Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Raw").Select
For Each cell In Range("J7:J" & lRow)
    If cell = "X" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    End If
Next cell

For Each cell In Range("N7:O" & lRow)
    If cell = "Y" Or cell = "Z" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    End If
Next cell

Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("New").Select

End Sub

I'm assuming that your criteria are in Columns J, N & O.

I've attached my test work book for your perusal here:-


https://www.dropbox.com/s/7hqtmpemx2fjh4j/MKader.xlsm?dl=0


For the sake of the exercise, I've used the letters X, Y & Z as the criteria. See what you think.

I hope that this helps.

Cheerio,
vcoolio.

 

[MKader]

Hello vcoolio,

Thanks for your support - i tried it and it's working fine - however, it seems that there is a duplication in records so I isolated one criteria and it seems working, what I will try to do is to delete the records in the New sheet that are not relative based on some criteria,

Thanks,
MK

 

[vcoolio]

Hello MKader,

To prevent the duplication in the "New" sheet, we could make this minor adjustment to the code:-

Sub CopyData()

Application.ScreenUpdating = False

Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Raw").Select
For Each cell In Range("J7:J" & lRow)
    If cell = "X" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    cell.EntireRow.ClearContents
    End If
Next cell

For Each cell In Range("N7:O" & lRow)
    If cell = "Y" Or cell = "Z" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    cell.EntireRow.ClearContents
    End If
Next cell

Sheets("Raw").Columns("A").SpecialCells(4).EntireRow.Delete
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("New").Select

End Sub

This will clear the used data from the "Raw" sheet as I suppose that you won't need it anymore after it is transferred to the "New" sheet.

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

Sorry MKader,

I meant this adjustment:-

Sub CopyData()

Application.ScreenUpdating = False

Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Raw").Select
For Each cell In Range("J7:J" & lRow)
    If cell = "X" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    cell.EntireRow.ClearContents
    End If
Next cell

For Each cell In Range("N7:O" & lRow)
    If cell = "Y" Or cell = "Z" Then
    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    cell.EntireRow.ClearContents
    End If
Next cell

With ActiveSheet
    .AutoFilterMode = False
    With Range("A7", Range("A" & Rows.Count).End(xlUp))
        .AutoFilter 1, ""
        On Error Resume Next
        .Offset(1).SpecialCells(4).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("New").Select

End Sub

Cheerio,
vcoolio.

 

[MKader]

Hi Vcoolio,

Much appreciated - it's working perfectly fine - done some modification - failed to get the paste to start from the same row [7] - ended up with paste starting at row 7 but with the 1st finding in RAW sheet -

Any ideas,

THanks,
MK

 

[vcoolio]

Greetings MK,

failed to get the paste to start from the same row [7] - ended up with paste starting at row 7 but with the 1st finding in RAW sheet -

I'm not following you exactly but are you saying that you need the transferred data to start on row 7 in the "New" sheet? Does this mean that you have headings, titles etc. in rows 1 - 6 in the "New" sheet?

Upload a snippet of your work book for me so that I can see exactly what you need to do. Include any changes that you may have made to the code. If you have any sensitive data, just change it to dummy data. You can upload a sample using a free file sharing site such as DropBox.

Cheerio.
vcoolio.

 

[MKader]

Hi Vcoolio,

That's what I mean - yea - to have the paste in the New sheet starting from row 7 - as - 1-6 have headers and disclaimers ...

Thanks,
MK

 

[vcoolio]

Hello again MK,

The code will find the first available row to commence pasting the transferred data to. So, if your headings etc. are in rows 1 - 6, then the code will start off at row 7 as it searches from the bottom up.

I've adjusted the sample work book:-

https://www.dropbox.com/s/7hqtmpemx2fjh4j/MKader.xlsm?dl=0

to show you this. I don't know what changes you have made to the code, but it should still work the same for you in regards the first available row.

Cheerio,
vcoolio.