копировать и вставлять только фильтры ячеек из одного Excel в другой Excel с помощью VBA - PullRequest
0 голосов
/ 24 октября 2019

У меня возникла проблема, когда я пытаюсь скопировать отфильтрованные ячейки из одного файла Excel и вставить его в другой файл. Я использую вызов макроса для получения данных, где я пытаюсь исправить этот код. Это работает, когда я пытаюсь скопировать ячейки, которые не отфильтрованы. Проблема возникает только при попытке скопировать только видимые ячейки. Я хотел бы попросить помощи, чтобы решить эту проблему.

Private Sub CommandButton1_Click()

    Dim lrCD As Long
    Dim fNameAndPath As Variant
    Dim WB As Workbook
    Dim SourceWB As Workbook
    Dim WS As Worksheet
    Dim ASheet As Worksheet
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Seleziona il file da aprire")

    'Sets the variables:
    Set WB = ActiveWorkbook
    Set ASheet = ActiveSheet
    Set SourceWB = Workbooks.Open(fNameAndPath)  'Modify to match

    'Copies each sheet of the SourceWB to the end of original wb:
    For Each WS In SourceWB.Worksheets
        WS.Copy after:=WB.Sheets(WB.Sheets.Count)
    Next WS

        SourceWB.Close savechanges:=False
        Set WS = Nothing
        Set SourceWB = Nothing

    WB.Activate
    ASheet.Select

    Set ASheet = Nothing
    Set WB = Nothing

    Application.EnableEvents = True
    lastrow = Worksheets(4).Cells(Rows.Count, 1).SpecialCells(xlCellTypeVisible).End(xlUp).Row


    For i = 3 To lastrow
        Worksheets(4).Cells(i, 16).SpecialCells(xlCellTypeVisible).Copy
        erow = Worksheets("CFF").Cells(Rows.Count, 1).SpecialCells(xlCellTypeVisible).End(xlUp).Row
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 2)
        Worksheets(4).Cells(i, 16).SpecialCells(xlCellTypeVisible).Copy
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 3)
        Worksheets(4).Cells(i, 15).SpecialCells(xlCellTypeVisible).Copy
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 4)
        Worksheets(4).Cells(i, 12).SpecialCells(xlCellTypeVisible).Copy
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 5)
        Worksheets(4).Cells(i, 13).SpecialCells(xlCellTypeVisible).Copy
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 6)
        Worksheets(4).Cells(i, 18).SpecialCells(xlCellTypeVisible).Copy
        Worksheets(4).PasteSpecial xlPasteValues = Worksheets("CFF").Cells(erow + 1, 1)
    Next i

    Application.CutCopyMode = False

     Sheets(4).Select
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.Delete

     Sheets(2).Select           

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