VBAmacros没有正确粘贴

我创build了一个VBmacros,它将两张纸上的数据合并成一张纸,这样就可以将其打印出来并作为我们正在处理的项目的概览。

它应该(在过去)是去到表1,将所有的数据从A到A列中的最后一行的R复制。

然后,它将粘贴从组合工作表的A3开始的数据。

然后它从工作表2中以相同的方式复制数据,并将其粘贴在组合工作表中最后使用的行之后。

我最近做了一些调整,现在这个macros似乎没有工作。

它正确地粘贴第一张工作表(精益项目),但第二张工作表的数据(Kaizen)未正确复制。

不是将所有数据复制到最终input行,而是复制第一个工作表中的行数之后的所有数据。 (例如:如果工作表1中有24个条目,工作表2开始复制到第25行。

Sub CreateCombinedSheet() 'Assign the worksheets to their respective variables Set wsCombined = Sheets("Combined (View)(Macro)") Set wsProjects = Sheets("Lean Projects (View)") Set wsKaizen = Sheets("Kaizen (View)") 'Clear the Combined worksheet before repopulating it if there is data present 'If the first cell of data, A3, is not empty If wsCombined.Range("A3") <> "" Then 'Then clear all rows after row 3 until the last row wsCombined.Range("A3", wsCombined.Range("A1048576").End(xlUp).Address).EntireRow.Delete End If 'Copy all the data in the Lean Projects worksheet wsProjects.Range("A3", wsProjects.Range("R3").End(xlDown).Address).Copy 'Paste the Lean Projects data into the Combined worksheet wsCombined.Range("A3").PasteSpecial 'Copy all the data in the Kaizen worksheet wsKaizen.Range("A3", wsKaizen.Range("R3").End(xlDown).Address).Copy 'Paste the Kaizen data into the Combined worksheet starting in the row after the currently last used row wsCombined.Range("A" & wsCombined.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial End Sub 

如果任何人都可以告诉我哪里出了错,我会感激的帮助。

谢谢,

例: 在这里输入图像说明

11/18更新:

我评论了第二个粘贴function,所以我可以看到自己究竟是什么被复制。 我发现它是从第二个工作表复制正确的数据。 当我将数据粘贴到组合工作表的最后一行后(第一张数据结束之后),就会出现问题。 当我手动过去的时候,我会看到所有的第二张数据。 然后一秒钟后,它看起来向上塌陷,Im留在第二张纸的第25行的数据到最后一行(28),然后将纸张2上的公式推到组合纸张上的第50行。

尝试在每个.PasteSpecial代码行之后添加一个xlPasteValues

 wsCombined.Range("A3").PasteSpecial xlPasteValues 

 wsCombined.Range("A" & wsCombined.Range("A" & .Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 

更正(在我看来)

 If wsCombined.Range("A3") > 0 Then 

应该成为

 IF wsCombined.Range("A3").Value <> "" Then 

不要使用自定义函数结束函数。 这是多余的,并限制你可以用它做什么。

 wsCombined.Rows("3:" & LastRow(wsCombined)).ClearContents 

应该成为

 wsCombined.Range("A3",WSCombined.Range("A1048576").End(xlup).Address).EntireRow.Delete 

另一个

 wsProjects.Range("A3:" & "R" & LastRow(wsProjects)).Copy 

应该成为

 wsProjects.Range("A3",wSProject.Range("R3").End(xlDown).Address).Copy 

等等等等。 我会很快回到这个答案,但我会想象如果你删除你的自定义函数,并使用内置的function,这个错误将消失。