У меня возникла проблема, когда я пытаюсь скопировать отфильтрованные ячейки из одного файла 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