Question

我是一个新的vba用户，我在循环中遇到类型13错误的问题。我目前有两本工作簿。一个有大约19张我需要复制数据的工作簿，另一个工作簿我要粘贴所有数据，这些数据将输入到我的数据透视表中。这种方法甚至是最好的解决方法吗？

Private Sub Update_Click()
Dim COOupdate As Workbook
Dim ws As Worksheet
Dim nrow As Long
Dim destrange As Range


Set COOupdate = Workbooks.Open("file path & file name")
Set ws = ActiveSheet
nrow = 2
Set destrange = ThisWorkbook.Worksheets(5).Range("b" & nrow)

COOupdate.Activate

For Each ws In ActiveWorkbook.Worksheets
    If ActiveSheet.Name = "Data Sheet" Or "Parameters" Then
    ActiveSheet.Next.Select
Else
    ActiveSheet.Range("B5:B71,E5:E71,H5:H71,K5:K71,N5:N71,Q5:Q71").Copy 
Destination:=ThisWorkbook.Worksheets(5).Range("b" & nrow)
    ActiveSheet.Range("b2").Copy 
Destination:=ThisWorkbook.Worksheets(5).Range("a2:a68")
    nrow = nrow + destrange.Rows.Count
  ActiveSheet.Next.Select
End If
Next

ActiveWorkbook.Close
ThisWorkbook.Save

End Sub

Answer 1

您的OR语法不太正确，而且无需激活工作表。将你的循环改为此。你的第二个副本似乎是覆盖了。

For Each ws In ActiveWorkbook.Worksheets
    If Not (ws.Name = "Data Sheet" Or ws.Name = "Parameters") Then
        ws.Range("B5:B71,E5:E71,H5:H71,K5:K71,N5:N71,Q5:Q71").Copy _
            Destination:=ThisWorkbook.Worksheets(5).Range("b" & nrow)
        ws.Range("b2").Copy _
            Destination:=ThisWorkbook.Worksheets(5).Range("a2:a68")
        nrow = nrow + destrange.Rows.Count
    End If
Next

Answer 2

我认为@SJR通过If ActiveSheet.Name = "Data Sheet" Or "Parameters" Then指出问题来解决问题的关键。

我还没有对此代码进行过测试，但它应该可以正常运行并显示原始代码的一些改进：

Private Sub Update_Click()
    Dim COOupdate As Workbook
    Dim dest_ws As Worksheet
    Dim ws As Worksheet

    Set COOupdate = Workbooks.Open("file path & file name")

    'Going to paste to this sheet:
    Set dest_ws = ThisWorkbook.Worksheets("Destination Sheet") 'Update name as required.

    'Going to copy from all sheets, except "Data Sheet" & "Parameters"
    For Each ws In COOupdate.Worksheets
        Select Case ws.Name
            Case "Data Sheet", "Parameters"
                'Do nothing
            Case Else
                ws.Range("B5:B71,E5:E71,H5:H71,K5:K71,N5:N71,Q5:Q71").Copy _
                    Destination:=LastCell(dest_ws).Offset(1)
        End Select
    Next ws

    COOupdate.Close
    'ThisWorkbook.Save  'Uncomment after tested.

End Sub

'Returns reference to last cell containing data on the worksheet.
Public Function LastCell(wrkSht As Worksheet) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With wrkSht
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    End With

    On Error GoTo 0

End Function

对于每种类型13错误vba

2 个答案: