Question

所以我的问题是：我有一个生成OfferCodes的列（所以所有单元格都包含一个公式）.lets说它的列A. 列B，C有其他数据，如客户，发行日期等。 D列是OrderConfirmation，只有在确认报价时，用户才会将其填入（日期）。

我需要的是复制（在另一个工作表中）列A列（QuoatationCodes）＆＃39;（以及其他列，但如果我知道如何为1列执行此操作，我想我将能够做到其余部分也是如此）只有当它在D列中得到确认日期时（基本生成一个订单列表，在新工作表中生成唯一的生产订单代码。

我现在拥有的是生产订单清单，其中包含尚未确认的优惠的空白行我需要这个自动刷新/动态。在新数据输入（在D列中）或通过控制按钮...

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

提前谢谢你，

安耶洛斯

Answer 1

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

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

仅当下一列中的单元格不为空时，才将单元格从列复制到另一个工作表

1 个答案: