Copy Cells from a Column to another sheet, only if

Question

So my problem is this: I have a column that generates OfferCodes (so all cells contain a formula).lets say it's column A. columns B, C have other data like customer, and issue date etc. Column D is OrderConfirmation and the user fills it in (the date) only when the quotation is confirmed.

What I need is to copy (in another worksheet) a list of column A (QuoatationCodes) '(and other columns, but if I know how to do it for 1 column I suppose I will be able to do it for the rest as well) only if it gets a confirmation date in column D. (basicaly generate an order list where in the new sheet generates unique production-order codes.

What I have now is a list of production-orders with blank rows for the Offers that have not been confirmed) I need this to refresh automatically/dynamicaly. either on new data entry ( In column D) or by a control button ...

Note that (source) column A will be ever expanding and data entry on Column D (where we have our criteria eg.not blank) is on a daily basis.

Thank you in advance,

Angelos

Answer 1

Try to use this code. Hope it helps:

Sub test()
   Dim sh1 As Worksheet
   Dim sh2 As Worksheet
   Dim lastrow1 As Long
   Dim lastrow2 As Long
   Dim j As Long
   Dim i As Long
   Dim rng As Range

   'set correct name of the sheet with your data'
   Set sh1 = ThisWorkbook.Worksheets("Sheet1")

   'set correct name of the sheet where you need to paste data'
   Set sh2 = ThisWorkbook.Worksheets("Sheet2")

   'determining last row of your data in file DEPOT_products.xlsx'
   lastrow1 = sh1.Range("A" & sh1.Rows.Count).End(xlUp).Row

   'determining last row of your data in file NewDepotProdsDB.xls'
   lastrow2 = sh2.Range("A" & sh2.Rows.Count).End(xlUp).Row

   'clear content in sheet2
   sh2.Range("a2:d" & lastrow2).ClearContents

   'suppose that in sheet2 data starts from row #2
   j = 2

   For i = 0 To lastrow1

       Set rng = sh1.Range("d1").Offset(i, 0)
       'check whether value in column D is not empy
       If Not (IsNull(rng) Or IsEmpty(rng)) Then
           sh1.Range("a" & i + 1 & ":d" & i + 1).Copy
           sh2.Range("a" & j).PasteSpecial xlPasteValues
           j = j + 1
       End If
   Next i
   Application.CutCopyMode = False
End Sub