vba - Excel VBA代码，一个宏在单独运行时工作，但在一组运行时调试

Question

我的程序通过调用一些宏来工作:

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 自行运行时，它可以完美运行，但是当我尝试运行整个程序时，它会进行调试。粗线是调试发生的地方。

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

替换这部分代码

 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

现在试试看。

还有一些tips

避免 .Select和 .Activate它们是导致错误的主要原因

缩进并适本地注释您的代码。您的代码很难阅读。如果您不缩进/注释您的代码，您将意识到如果您在一周后访问它，您将无法识别您的 OWN 代码:)