VBA复制excel工作表，追加特定列中的新行

Question

我使用Excel为计费系统生成报表，并且我想使用VBA来简化更新Excel的过程。我想要做的是从Mastersheets中的列（“A：F”）中复制，粘贴和追加信息，并根据名称在其各自的命名工作表中将它们分开。所有表从第4行开始。（第3行是标题）

所以我将进一步简化这个过程： 从一个新的Excel表开始，我想首先将所有数据从主表复制并粘贴到各自的命名工作表。完成后：

COPY，PASTE和APPEND（当主菜单发生更改时） 1.选择主菜单。 2.在主表格中，搜索现有工作表栏（A）以查询帐单号码（为了只允许更新现有数据的新帐单） 3.从列（“A：F”）复制并粘贴新帐单号码从每个命名工作表的最后一个空行开始命名工作表。 （我认为我已经在代码中定义了它，“乔治”表有一个问题，它没有穿过整个工作表，它停在某个行号）

我现在的问题是我不能使附加功能工作。复制和粘贴功能或多或少地完成。这是我迄今为止的代码。这是我现在制定的一切。任何帮助将不胜感激。

' COPY, PASTE AND APPEND 
Sub Append() 

Dim manager As String, lastrow As Long, i As Integer 
Dim find As Range, bill As String 


Set mastersheet = Sheet1 

mastersheet.Select 
bill = Sheet1.Range("A:A").Value 
Do While Not bill = "" 
Set find = Sheet1.Range("A:A").find(what:=bill, lookat:=xlValues, lookat:=xlWhole) 
If find Is Nothing Then 

lastrow = Cells(Rows.Count, 1).End(xlUp).row 

For i = 2 To lastrow 
If Cells(i, 2) = "JOHN" Then 
    Range(Cells(i, 1), Cells(i, 6)).copy 
    Sheet13.Select 
    Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    mastersheet.Select 

    End If 

Next i 
For i = 2 To lastrow 
If Cells(i, 2) = "CHARLIE" Then 
    Range(Cells(i, 1), Cells(i, 6)).copy 
    Sheet11.Select 
    Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    mastersheet.Select 
    End If 
Next i 
For i = 2 To lastrow 
If Cells(i, 2) = "GEORGE" Then 
    Range(Cells(i, 1), Cells(i, 6)).copy 
    Sheet12.Select 
    Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    mastersheet.Select 
    End If 
Next i 

Else 

Sheet1.Select 

End If 
Loop 

End Sub 

Answer 1

我试着清理代码（很多.select），首先。你没有定义你的.pastespecial在粘贴表上打印的内容。如果您只是粘贴，那么您可以缩短该行，并将粘贴位置与复制位置放在同一行，而不指定粘贴;它假定你只是从指定位置移动到新位置。

我相信在改变并从George的循环中删除mastersheet.select，它可能有助于清理该工作表。我不是说是这个问题，但是不会伤害到这样。此外，我给你更多的定义变量，以保存值（i，i，j和k）没有问题。

希望这些变化帮助不仅仅是阻碍！

' COPY, PASTE AND APPEND 
Sub Append() 

Dim manager As String, lastrow As Long, i As Integer, k as integer, j as integer 
Dim find As Range, bill As String 

bill = Sheets("Sheet1").Range("A:A").Value 
Do While Not bill = "" 
Set find = Sheets("Sheet1").Range("A:A").find(what:=bill, lookat:=xlValues, lookat:=xlWhole) 

If find Is Nothing Then 

lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row 

For i = 2 To lastrow 
    If Cells(i, 2) = "JOHN" Then 
    Range(Cells(i, 1), Cells(i, 6)).copy 
    Sheets("Sheet13").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
Next i 

For j = 2 To lastrow 
    If Sheets("Sheet1").Cells(j, 2) = "CHARLIE" Then 
    Sheets("Sheet1").Range(Cells(j, 1), Cells(j, 6)).copy 
    Sheets("Sheet11").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
Next j 

For k = 2 To lastrow 
    If Sheets("Sheet1").Cells(k, 2) = "GEORGE" Then 
    Sheets("Sheet1").Range(Cells(k, 1), Cells(k, 6)).copy 
    Sheets("Sheet12").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
Next k 

Else 

Sheets("Sheet1").Select 

End If 
Loop 

End Sub