vba - 设置目的地错误

Question

我的宏有问题。它是一个 Excel，经过过滤后，将数据复制到另一个 Excel 书中。当我宣布命运时，它给我带来了问题，但我不知道问题是什么。

你可以帮帮我吗？

Sub EnviarDatosVictoria()

    Dim wbLibroActual, wbLibroVictoria, wbLibroNuevo As Workbook
    Dim wsHojaActual, wsHojaVictoria As Worksheet
    Dim RangoDatos As Range
    Dim uFila As Long

    Dim RutaDestino As String

    RutaDestino = "Victoria.xlsx"

    'Datos Libro Actual
    Set wbLibroActual = Workbooks(ThisWorkbook.Name)
    Set wsHojaActual = wbLibroActual.ActiveSheet

    'Cogemos el rango que queremos copiar, que es todo lo usado
    Set RangoDatos = wsHojaActual.UsedRange

    'Establecemos el filtro
    RangoDatos.AutoFilter Field:=34, Criteria1:="OTRA"

    'Contamos el numero de filas (hasta la ultima)
    uFila = wsHojaActual.Range("A" & Rows.Count).End(xlUp).Row

    'Copiar datos de filtro
    wsHojaActual.Range("A1:AM" & uFila).Copy

    'Datos Destino'
    Set wbLibroVictoria = Workbooks.Open(RutaDestino)
    Set wsHojaVictoria = wbLibroVictoria.Worksheets("Hoja1")

    wbHojaVictoria.Paste
    Application.CutCopyMode = False
    Windows(wbLibroActual.Name).Activate
    wsHojaActual.Range("A1").Select
    Selection.AutoFilter

End Sub

错误是这样的：

标签： vbaexcel

Answer 1

我看到这段代码有很多问题。顺便说一句，这不是您设置自动过滤器范围或应用过滤器或复制过滤结果或打开另一个工作簿的方式....

这是你正在尝试的吗？我已经评论了代码，所以你不应该遇到任何问题。此代码未经测试，因此如果您发现错误，请告诉我，我会修改它。我假设Row 1有标题。

Sub EnviarDatosVictoria()
    Dim wbThis As Workbook, wbThat As Workbook
    Dim wsThis As Worksheet, wsThat As Worksheet
    Dim wbThatPath As String
    Dim rngToCopy As Range, rngAutofilter As Range
    Dim lRow As Long

    '~~> Change path accordingly
    wbThatPath = "C:\Temp\Victoria.xlsx"

    Set wbThis = ThisWorkbook

    '~~> Change the name of the sheet as applicable
    Set wsThis = wbThis.Sheets("Sheet1")

    With wsThis
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rngAutofilter = .Range("A1:AM" & lRow)

        '~~> Remove any filters
        .AutoFilterMode = False

        With rngAutofilter
            '~~> Filter, offset(to exclude headers) and copy visible rows
            .AutoFilter Field:=34, Criteria1:="OTRA"

            '~~> Set your copy range
            Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    '~~> Check if there is something in the copyrange or not
    '~~> If there is then open another workbook
    If Not rngToCopy Is Nothing Then
        Set wbThat = Workbooks.Open(wbThatPath)
        Set wsThat = wbThat.Sheets("Hoja1")

        '~~> Copy Headers
        wsThis.Rows(1).Copy wsThat.Rows(1)
        '~~> Copy Filtered data
        rngToCopy.Copy wsThat.Rows(2)
    End If

    Application.CutCopyMode = False
End Sub