Question

我有以下代码，假设从我在电子邮件中收到的excel文件中复制数据并将其粘贴到具有相同日期的行上的另一个文件中。当我尝试运行宏时，它表示存在错误。任何人都可以查看我的代码，并指导我的错误在哪里。我是编码和创建宏的新手。

Sub CopyDataToPlan()

Dim LDate As String
Dim LColumn As Integer
Dim LFound As Boolean
Dim WS As Worksheet


On Error GoTo Err_Execute

Set WS = Workbooks("McKinney Daily Census Template OCT 10.xls").Sheets("McKinney")


'Retrieve date value to search for
WS = Workbooks("McKinney Daily Census Template OCT 10.xls").Cell("B15").Value

Sheets("Input").Select

'Start at column B
LColumn = 2
LFound = False

While LFound = False

    'Encountered blank cell in row 2, terminate search
    If Len(Cells(2, LColumn)) = 0 Then
        MsgBox "No matching date was found."
        Exit Sub

    'Found match in row 2
    ElseIf Cells(2, LColumn) = LDate Then

        'Select values to copy from "McKinney" sheet
        Sheets("McKinney Daily Census Template OCT 10.xls").Select
        Range("C15:I15").Select
        Selection.Copy

        'Paste onto "Key Indicator" sheet
        Sheets("Input").Select
        Cells(3, LColumn).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

        LFound = True
        MsgBox "The data has been successfully copied."

    'Continue searching
    Else
        LColumn = LColumn + 1
    End If

Wend

On Error GoTo 0

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Answer 1

哪一行会产生错误？看来您的变量LDate从未收到日期。可能不是

WS = Workbooks("McKinney Daily Census Template OCT 10.xls").Cell("B15").Value

你打算写

LDate = Workbooks("McKinney Daily Census Template OCT 10.xls").Cell("B15").Value

所有这些看起来都非常长而危险的代码：为什么不a）从输入表中获取日期和要复制的数据（看起来你可以将它们放在带有for循环的数组中）然后b ）搜索包含所需日期的单元格（1个语句）以检索与所需日期匹配的单元格行，然后c）将数据从数组循环到工作表。

Answer 2

使用引用更明确。代码运行得更快，更容易调试：

Sub CopyDataToPlan()
Dim LDate As String
Dim LColumn As Integer
Dim LFound As Boolean
Dim WkbCensus As workbook
Dim WksCensus As worksheet
Dim WkbThis As workbook
Dim WksInput As worksheet

On Error GoTo Err_Execute

Set WkbThis = thisworkbook
Set wksInput = WkbMe.Sheets("Input")
Set WkbCensus = Workbooks("McKinney Daily Census Template OCT 10.xls")
Set WksCensus = Wkb.Sheets("McKinney")

LDate = WksCensus.Cell("B15").Value

LColumn = 2
LFound = False

While LFound = False
    If Len(wksInput.cells(2, LColumn)) = 0 Then
        MsgBox "No matching date was found."
        Exit Sub
    ElseIf wksInput.cells(2, LColumn) = LDate Then
        WksCensus.Range("C15:I15").copy
        wksInput.cells(3, LColumn).pastespecial Paste:=xlValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        LFound = True
        MsgBox "The data has been successfully copied."
    Else
        LColumn = LColumn + 1
    End If
Wend

On Error GoTo 0

Exit Sub

Err_Execute:
     MsgBox "An error occurred."
 End Sub

使用宏从/向Excel工作表复制数据

2 个答案: