循环只粘贴在具有数据的行上

任何人都可以帮助我修改这个循环来复制和粘贴？

我想粘贴Range("S" & Y).Select 。只有在时间，date或n / a格式的数据在Range("F" & Y) ，才能在同一行中select。 我想重复这个，直到Range("F" & Y)的最后一个数据点Range("F" & Y) 。 我现在有数据在Range("F" & Y)的行，那么它不应该粘贴Range("S" & Y) 。 当Range("F" & Y)有数据时，每三行显示一次。 有时在数据中可能有10行，直到返回到每三行的下一个数据序列。

错误 ：它不会停止在该数据集的末尾，即使Range("F" & Y)没有数据也会粘贴Range("F" & Y)任何人都可以帮忙吗？

我的代码

 Dim lastRow As Long Range("S16:Y16").Select Selection.Copy For Y = 19 To 2000 Step 3 If Range("F" & Y).Value = lastRow Then Exit For Range("S" & Y).Select ActiveSheet.Paste lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row Next Y Application.ScreenUpdating = True MsgBox lastRow 

Answer 1

几点提示：

1. 首先，当lastRow大于2000时，它不会停止，并且if语句不会检查当前行号是否是其中的值。 同样，你跳过最后一行的机会很大，因为你一次跳过3行。 我build议你使用if语句来代替：

    If Range("F" & Y).row > lastRow Then Exit For 

2. 对于你的lastrowvariables，我build议以下更准确：

    lastrow = activesheet.cells.find("*", range("A1"), , , xlbyrows, xlprevious).row 

3. 此外，你粘贴每一行数据，而不检查一个空白值，我会检查一个空白单元格使用这个：

    if len(Application.WorksheetFunction.Clean(trim(range("F" & Y).value))) > 0 then 

Answer 2

也许你可以用列S到Y中的工作表公式来做到这一点：

 =IF($F:$F<>"",S:S,"") 

从S列到Y列复制该公式，然后降至2000年。

要检查ROW是否每隔三行，使用ROW（）函数获取行号，并使用MOD来查看它是否可以被3整除？

对于VBA，试试这个：

 Dim lastRow As Long lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row Range("S16:Y16").Copy For Y = lastRow to 19 Step -3 ' check column F and Row=Y for contents if vba.len(vba.trim(range("F" & Y).value))>0 then ' paste into column S Range("S" & Y).PasteSpecial xlPasteAll end if Next Application.ScreenUpdating = True MsgBox lastRow 

现在它将从lastRow运行到19

你的代码是检查单元格Range（“F”＆Y）或Cells（y，6）的值与最后一行的数字