Фильтр в Excel пропускает имена, почему? - PullRequest
0 голосов
/ 22 февраля 2019

У меня странная проблема при обновлении книг Excel для консультантов.Похоже, что фильтрация работает неправильно, поскольку она не всегда выбирает имя консультанта из wsTarget для фильтрации wbSource.

Я действительно ослеплен, потому что это работает для некоторых имен и не для других.Я дважды проверил, и имена совпадают в wsTarget и wsSource.

Есть предложения?

Sub CopyToWorkbooks()
    Application.ScreenUpdating = False

    Dim strPath As String
    Dim strFile As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsConsultant As Worksheet
    Dim wsTarget As Worksheet
    Dim cons As Range

    strPath = "xxx"
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

    Set wsSource = Workbooks("JobsOn.xlsm").Worksheets("TOCOPY")

    strFile = Dir(strPath & "*.xlsx*")

    Do Until strFile = ""
        If strFile <> ThisWorkbook.Name Then
            Set wbtarget = Workbooks.Open(strPath & strFile)
            Set wsTarget = wbtarget.Worksheets("Revenue Tracker")
            Set cons = wbtarget.Worksheets("Revenue Tracker").Range("C1")

            wsSource.Range("$A$1:$F$10000").AutoFilter Field:=5, Criteria1:=cons

            wsTarget.Unprotect Password:="xxx"

            On Error Resume Next

            wsSource.Range("B2:B37").SpecialCells(xlCellTypeVisible).Copy
            wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).PasteSpecial xlPasteValues
            wsSource.Range("C2:C37").SpecialCells(xlCellTypeVisible).Copy
            wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 2).PasteSpecial xlPasteValues
            wsSource.Range("D2:D37").SpecialCells(xlCellTypeVisible).Copy
            wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 4).PasteSpecial xlPasteValues
            'wsSource.Range("F2:F37").SpecialCells(xlCellTypeVisible).Copy
            'wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 8).PasteSpecial xlPasteValues
            wsSource.Range("A2:A37").SpecialCells(xlCellTypeVisible).Copy
            wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

            wsTarget.Columns.AutoFit

            wsTarget.Protect Password:="jayne", DrawingObjects:=True, Contents:=True, Scenarios:=True

            Application.DisplayAlerts = False

            wbtarget.Save
            wbtarget.Close

            Application.DisplayAlerts = True

            wsSource.AutoFilter.ShowAllData
        End If

        strFile = Dir()
    Loop

    Worksheets("UNIQUE").Range("A2:F100000").FormatConditions.Delete
    Worksheets("UNIQUE").Range("G2:G100000").Clear

    wsSource.Range("A2:F10000").Clear

    Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 25 февраля 2019

ОК, я нашел решение ... Глупый я ...

Range("B2:B37")

Эта часть вызвала всю путаницу.Было больше строк для копирования, и поэтому были скопированы только некоторые.Я просто изменяю диапазон с Range("B2:B37") на Range("B2:B10000") и все работает отлично

Спасибо @BruceWayne за предложение по использованию F8.Это помогло!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...