VBA if column B contains "New" copy only specific cells to another sheet

[cizzett]

So I have a heavily VBA and Macro laden workbook that I have continued to work on to simplify and streamline data tasks, as well as keeping the others from struggling in my absence.

What I am trying to do is if column B contains text "New" then copy ONLY cells D:F, I, O:P and paste them to the next available row on worksheet L.W.S.

I have one VBA code that works to copy the entire row of data and paste it to another workbook (My annual summary of data) but I am struggling to make it work for just these specific cells into the worksheet in this same workbook.

Any Ideas?

The data is on on worksheet "Today" and the worksheet I want to paste to is L.W.S.

Thanks in Advance

 

[vcoolio]

Hello Cizzett,

Try the following code:-

Sub Test()

Dim ws As Worksheet: Set ws = Sheets("Today")
Dim sh As Worksheet: Set sh = Sheets("L.W.S.")

Application.ScreenUpdating = False

With ws.[A1].CurrentRegion
        .AutoFilter 2, "New"
        Union(.Columns("D:F"), .Columns("I"), .Columns("O:P")).Offset(1).Copy sh.Range("A" & Rows.Count).End(3)(2)
        .AutoFilter
End With

Application.ScreenUpdating = True

End Sub

It assumes that data starts in Row2 with headings in Row1.

I hope that this helps.

Cheerio,
vcoolio.

 

[cizzett]

Hey Thanks, this works well. Is it possible to alter this to paste text only? I dont want to drag formatting etc along.

 

[cizzett]

I've been playing with this but I need to figure out how to get it to only copy those specific cells

Sub LotWS()


Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        
   Dim Nws As Worksheet
   Dim Mws As Worksheet
    Set Mws = ThisWorkbook.Sheets("Today")
        Set Nws = ThisWorkbook.Sheets("L.W.S.")
        
    If Mws.FilterMode Then Mws.ShowAllData
            Mws.Range("A1:j1").AutoFilter 2, "New"
        Mws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy
    Nws.Range("A2").End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Mws.ShowAllData
   
  
          Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub

 

[vcoolio]

Hello Cizzett,

To paste values only:_

Sub Test()

Dim ws As Worksheet: Set ws = Sheets("Today")
Dim sh As Worksheet: Set sh = Sheets("L.W.S.")

Application.ScreenUpdating = False

With ws.[A1].CurrentRegion
        .AutoFilter 2, "New"
        Union(.Columns("D:F"), .Columns("I"), .Columns("O:P")).Offset(1).Copy
     [COLOR=#ff0000]   sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues[/COLOR]
        .AutoFilter
End With

Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.

 

[cizzett]

Awesome, Thanks so much this works great.

 

[vcoolio]

You're welcome Cizzett. I'm glad that I was able to help.

Cheerio,
vcoolio