将填充的单元格中的值仅复制到不同的工作表，而不会在最后填充的值之后有多余的行
首先，稍微search一下Google-Fu。 我用一些VBA拼凑了一个可用的Excel电子表格。 我绝不是编码员，也不是我的专业，但是，这是我基本的了解。 那就是说，我一直把头撞在墙上。
我将数据从一个网站拖到Excel中的工作表1中，将其复制到工作表2，同时清理数据，再次将其复制到工作表3，以进一步隔离我需要的信息。 （我知道这是一个过于复杂的过程，但是通过逐步完成这个过程，我可以更好地理解正在发生的事情，这有助于我学习）。
第一步，将开采的网站数据复制到sheet2中：
Sub DataReOrganizer() Dim s1 As Worksheet, s2 As Worksheet Dim Cook As Long, i As Long, K As Long, v As String On Error Resume Next Set s1 = Sheets("Sheet1") Set s2 = Sheets("Sheet2") Cook = s1.Cells(Rows.Count, "A").End(xlUp).Row K = 2 For i = 1 To Cook v = s1.Cells(i, "A").Text If v = "Contact Information" Then K = K + 1 Else ary = Split(v, ": ") If ary(0) = "Name" Then s2.Cells(K, 1) = ary(1) If ary(0) = "License" Then s2.Cells(K, 2) = ary(1) If ary(0) = "License Status" Then s2.Cells(K, 3) = ary(1) If ary(0) = "City/State" Then s2.Cells(K, 4) = ary(1) If ary(0) = "County" Then s2.Cells(K, 5) = ary(1) If ary(0) = "Home Phone" Then s2.Cells(K, 6) = ary(1) If ary(0) = "Work Phone" Then s2.Cells(K, 7) = ary(1) If ary(0) = "Cell Phone" Then s2.Cells(K, 8) = ary(1) If ary(0) = "Email Address" Then s2.Cells(K, 9) = ary(1) If ary(0) = "Region" Then s2.Cells(K, 10) = ary(1) If ary(0) = "Ever Been Disciplined?" Then s2.Cells(K, 11) = ary(1) If ary(0) = "Note" Then s2.Cells(K, 12) = ary(1) End If Next I End Sub 现在信息不再是A列中的一大块，我转到步骤2：现在信息被复制到sheet3中，使用每列中的公式（A – N）例如：
=IFERROR(SUBSTITUTE(LEFT(Sheet2!$A2,SEARCH(", ",Sheet2!$A2)),",",""),"")
公式转到每列中的第1500行，这样做是为了保持从sheet3中的网站拉出的不断数量的数据总是有组织的。 我可能只有600行左右的数据，而其余的单元格，最多1500，是空白的。
这是我卡住的地方。 我可以将值（减去公式）复制到sheet4。 但是，它会复制填充的值和公式中没有计算值的单元格的900行左右。 我search并find了各种代码来删除空单元格，但他们不工作，或者我无法弄清楚如何调整他们的使用。 无论我使用什么代码复制，它总是返回1500行，只有600个左右填充。 我错过了什么吗？ 我甚至试图复制新创build的工作表只有值，仍然返回1500行。
***编辑添加我目前用于testing目的的代码：
Sub Test_Copy() Worksheets("Sheet3").Range("A:N").Copy Worksheets("Sheet4").Range("A:N").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub
我发现另外一个问题，就是每次只复制一个单元的代码，但是速度非常慢。
Excelmacros – 只将非空单元格从一个表格粘贴到另一个表格
另外，我从反应中得到了印象，这不是一个好主意，也不是最佳实践。
编辑和固定
Sub test() Dim LastRow As Long For y = LastColumnInOneRow To 1 Step -1 LastRow = Sheets("Sheet3").cells(Sheets("Sheet3").Rows.Count, y).End(xlUp).row For x = LastRow To 1 Step -1 Sheets("Sheet4").cells(x, y).value = Sheets("Sheet3").cells(x, y).value Next x Next y End Sub Private Function LastColumnInOneRow() As Long With Sheets("Sheet4") LastColumnInOneRow = .cells(1, .Columns.Count).End(xlToLeft).column End With End Function