Excel VBA代码，一个macros在自己运行时工作，但在一个组中运行时debugging

我的程序通过调用一些macros来工作：

Sub Start() Call ClearAll Call Sales_Download Call Copy_Sales Call Receipt_Download Call Copy_Receipt Call Copy1 Call Sales_Summary Call Copy2 Call Receipt_Summary End Sub 

我的程序打破了copy2，这本质上是copy1的一个确切的副本，很好地工作。 当copy2本身运行时，它可以完美运行，但是当我尝试运行整个程序时，它会进行debugging。 粗体行是debugging发生的地方。

 Sub Copy2() ' Copies all data from Receipt Download tab for each location, and saves in a seperate folder Dim i As Long Dim lngLastRow As Long, lngPasteRow As Long 'Find the last row to search through lngLastRow = Sheets("Receipt_Download").Range("J65535").End(xlUp).Row 'Initialize the Paste Row lngPasteRow = 2 Dim rng As Range Dim c As Range Dim endrow Dim strName As String Dim ws As Worksheet Dim j As Long endrow = Sheets("names").Range("A65000").End(xlUp).Row Set rng = Sheets("names").Range("A2:A" & endrow) j = 1 FBO = strName For Each c In rng For i = 2 To lngLastRow strName = c.Value If Sheets("Receipt_Download").Range("J" & i).Value = strName Then Sheets("Receipt_Download").Select Range("A" & i & ":IV" & i).Copy Sheets("Summary").Select Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select ActiveSheet.Paste lngPasteRow = lngPasteRow + 1 End If Next i j = j + 1 Sheets("Receipt_Download").Select Rows("1:1").Select Selection.Copy Sheets("Summary").Select Rows("1:1").Select ActiveSheet.Paste Columns("D:E").Select Selection.NumberFormat = "m/d/yyyy" Sheets("Summary").Select Range("B25000").Select ActiveCell.FormulaR1C1 = "Grand Total" Range("B25000").Select Selection.Font.Bold = True Columns("G:G").Select Selection.Insert Shift:=xlToRight Range("G1").Select ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])" Range("G1").Select Selection.AutoFill Destination:=Range("G1:G24950") Range("G25000").Select ActiveCell.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)" Range("G25000").Select Selection.Copy Range("F25000").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("G:G").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Sheets("Summary").Select Range("F25000").Select Application.CutCopyMode = False Selection.Copy Sheets("Names").Select With Columns("B") .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate End With ActiveSheet.Paste Sheets("Summary").Select Range("b1:b30000").Select For Each Cell In Selection If Cell.Value = "" Then Cell.ClearContents End If Next Cell Range("b1:b30000").Select Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete Sheets("Summary").Select Range("D2").Select Application.CutCopyMode = False Selection.Copy Sheets("Names").Select ***With Columns("C") .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate*** End With ActiveSheet.Paste Sheets("Summary").Select Range("A1:Z5000").Select Selection.Copy Workbooks.Add ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False File = "C:\Documents and Settings\user\Desktop\New FBO\" & strName & "\" & strName & " Receipts.xls" ActiveWorkbook.SaveAs Filename:=File, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close IngPasteRow = IngPasteRow + 1 Sheets("Summary").Select Selection.ClearContents Next c End Sub 

我真的很感激任何帮助，我当然不是VBA高手，这是相当麻烦的。

Answer 1

replace你的代码的这部分

  Sheets("Summary").Select Range("D2").Select Application.CutCopyMode = False Selection.Copy Sheets("Names").Select With Columns("C") .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate End With ActiveSheet.Paste 

同

 Dim lRow As Long With Sheets("Names") lRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1 Sheets("Summary").Range("D2").Copy .Range("C" & lRow) End With 

现在尝试一下。

也有几个提示

1. 避免。select和.Activate它们是错误的主要原因
2. 缩进并适当评论你的代码。 你的代码很难阅读。 如果你不缩进/注释你的代码，你将会意识到，如果你在一个星期后访问它，你将无法识别你的OWN代码:)

Answer 2

为了支持上面的Siddharth的回答，我已经把你的代码的一部分（直到你的中断发生的地方）并缩进，并避免他提到的.Select和.Activate 。 希望这给你一个良好的开始如何使你的代码更易于debugging和理解。

 For Each c In rng For i = 2 To lngLastRow strName = c.Value If Sheets("Receipt_Download").Range("J" & i).Value = strName Then Sheets("Receipt_Download").Range("A" & i & ":IV" & i).Copy _ Destination:=Sheets("Summary").Range("A" & lngPasteRow & ":IV" & lngPasteRow) lngPasteRow = lngPasteRow + 1 End If Next i j = j + 1 Sheets("Receipt_Download").Rows("1:1").Copy Destination:=Sheets("Summary").Rows("1:1") With Sheets("Summary") .Columns("D:E").NumberFormat = "m/d/yyyy" With .Range("B25000") .Formula = "Grand Total" .Font.Bold = True End With .Columns("G:G").Insert Shift:=xlToRight With Range("G1") .FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])" .AutoFill Destination:=Range("G1:G24950") End With With ("G25000") .FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)" .Copy End With .Range("F25000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Columns("G:G").Delete Shift:=xlToLeft .Range("F25000").Copy Destination:=Sheets("Names").Columns("B").Find(what:="", after:=Sheets("Names").Cells(1, 1), LookIn:=xlValues) End With