将单元格从列复制到另一个工作表，只有下一列中的单元格不为空 [英] Copy Cells from a Column to another sheet, only if a cell in the next column is not blank

问题描述

所以我的问题是这样的：
我有一个列生成OfferCodes（所以所有单元格都包含一个公式）.lets表示它是列A.
列B，C有其他数据，如客户和发行日期等
列D是OrderConfirmation，用户仅在报价确认后才填写（日期）。

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.

我需要的是复制（在另一个工作表中）列A列表（QuoatationCodes）'（和其他列，但如果我知道如何做1列，我想我将能够为其余的）
只如果它在第D列获得确认日期（基本生成一个订单列表，其中在新表单中生成唯一的生产订单代码。

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.

我现在是一个列表的生产订单与尚未确认的优惠的空白行）
我需要这个来自动刷新/动态。在新的数据输入（在列D中）或通过控件按钮...

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 ...

请注意（源）列A将不断扩展，列D上的数据输入（我们的标准，例如，不是空白）每天都有。

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.

提前谢谢，

Angelos

推荐答案

尝试使用此代码。希望它有帮助：

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

这篇关于将单元格从列复制到另一个工作表，只有下一列中的单元格不为空的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！