VBA to pull "New" marked data to fixed workbook. Please help. Thanks

[cizzett]

I have been trying to get a VBA code to work for copying all rows that have "New" in the B column then copy that row A-X
and open a different workbook than paste the data to the next empty row.

I have been able to get this to work but it stops after the first instance it identifies.







Public Sub ExporttoDatabase()

Windows("Qlty Workbook Daily1").Activate
Sheets("Today").Select
' Find the last row of data
FinalRow = Worksheets("Today").Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For i = 2 To FinalRow
' Decide if to copy based on column B
ThisValue = Cells(i, 2).Value
If ThisValue = "New" Then
Cells(i, 1).Resize(1, 24).Copy

Workbooks.Open Filename:="I:\Inventory\Quality Reports (Tim)\2019 Qlty Data-Running.xlsm"
Sheets("Data").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste

End If
Next

Application.CutCopyMode = False
Windows("Qlty Workbook Daily1").Activate
Range("C3").Select


End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub ExporttoDatabase()
   Dim Wbk As Workbook
   Dim Mws As Worksheet, Nws As Worksheet
   
   Set Mws = ThisWorkbook.Sheets("Today")
   Set Wbk = Workbooks.Open("I:\Inventory\Quality Reports (Tim)\2019 Qlty Data-Running.xlsm")
   Set Nws = Wbk.Sheets("Data")
   If Mws.AutoFilterMode Then Mws.AutoFilterMode = False
   Mws.Range("A1:X1").AutoFilter 2, "New"
   Mws.AutoFilter.Range.Offset(1).Copy Nws.Range("A" & Rows.Count).End(xlUp).Offset(1)
   Mws.AutoFilterMode = False
   
   [COLOR=#0000ff]Wbk.Close True[/COLOR]
End Sub

This code needs to go in the "Qlty Workbook Daily1" workbook.
It will also save & close the other workbook. If you don't want that, remove the line in blue

 

[cizzett]

Tnks fo the reply

I forgot to mention that the data is in a table and the column B uses data validation in a drop down list.

This code pulls the data over but it also pulls all the conditional formatting and it pulled all the rows, not just the ones displaying "New" in Column B.

I'm assuming because its in table format.

 

[Fluff]

In that case try

Sub ExporttoDatabase()
   Dim Wbk As Workbook
   Dim Mws As Worksheet, Nws As Worksheet
   
   Set Mws = ThisWorkbook.Sheets("Today")
   Set Wbk = Workbooks.Open("I:\Inventory\Quality Reports (Tim)\2019 Qlty Data-Running.xlsm")
   Set Nws = Wbk.Sheets("Data")
   If Mws.FilterMode Then Mws.ShowAllData
   Mws.Range("A1:j1").AutoFilter 2, "New"
   Mws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy
   Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Mws.ShowAllData
   
   Wbk.Close True
End Sub

 

[cizzett]

Seems to be ignoring conditional formatting now but still copying like 60 rows including headers.

 

[Fluff]

If you step through the code using F8, when this line is highlighted

Mws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy

Look at the sheet you are copying from, has it been filtered correctly?

 

[cizzett]

No it is not, but this column is a data validation drop down selection.

Could that b affcting it as every row has"New" in i techcally een tough its not visibl?

 

[Fluff]

The fact that you have data validation on the column shouldn't make any difference.
Does your table start in A1 with headers in row1 & data starting row2?

 

[cizzett]

Actually I think I managed to get it working, I had to add a macro to remove all formulas from the sheet and leave the values then it only grabs the new cells.

Thanks.

 

[Fluff]

Glad you got it sorted & thanks for the feedback