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

错误是这样的：

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

设定目的地错误

1 个答案: