Работа с листами

[Flangini]

Доброго времени суток Вам!!!
Подскажите, пожалуйста, как средствами VBA скорировать только те ячейки из диапазона R3:T65536, которые оботразились на экране после выборке при помощи "автофильтра" и поместить их на соседний лист???

[SAS888]

Можно обрабатывать ячейки, принадлежащие пересечению диапазонов. В данном случае это Ваш диапазон и все видимые ячейки. Например:

Intersect(Range("R3:T65536"), Cells.SpecialCells(xlCellTypeVisible)).Copy Sheets(2).Range("A1")

Скопирует видимые ячейки Вашего диапазона на второй по счету лист, начиная с ячейки "А1".

[Flangini]

Подскажите, что-то не выходит. Вот такой вот макрос:
Sub обработка()
Dim x As Object
Dim CpD, CvC1, CvC2, CvC3, b As Single
On Error Resume Next
Set x = ActiveWorkbook.Sheets("SheetName")
Set NewSheet = Worksheets.Add
NewSheet.Name = "Work"
Intersect(Range("R3:T65536"), Cells.SpecialCells(xlCellTypeVisibl e)).Copy Sheets(2).Range("R3")
Set x = Worksheets("Work")
x.Activate
CpD = WorksheetFunction.Sum(Range("A1:C65 536"))
CvC1 = WorksheetFunction.Sum(Range("A1:A65 536"))
CvC2 = WorksheetFunction.Sum(Range("B1:B65 536"))
CvC3 = WorksheetFunction.Sum(Range("C1:C65 536"))
MsgBox "CpD = " & CpD, vbInformation, "1"
MsgBox "CvC1 = " & CvC1, vbInformation, "2"
CvC1 = (CvC1 * 100) / CpD
CvC2 = (CvC2 * 100) / CpD
CvC3 = (CvC3 * 100) / CpD
MsgBox "CvC1 = " & CvC1, vbInformation, "%"
MsgBox "CvC2 = " & CvC2, vbInformation, "%"
MsgBox "CvC3 = " & CvC3, vbInformation, "%"
End Sub

Почему-то только вырезает все ячейки из диапазона R3:T65536 и всё, а на лист "Work" ничего не копирует

[SAS888]

Вы "намудрили" с рабочими листами. Не запутайтесь. В данном случае нужно так:

Intersect(x.Range("R3:T65536"), x.Cells.SpecialCells(xlCellTypeVisible)).Copy Sheets("Work").Range("R3")

[Flangini]

А что именно я намудрил?
Просто после добавления Вашей строчки, ничего не происходит.

[SAS888]

Конечно, может это только часть Вашего макроса, но зачем Вы устанавливаете объект

Set x = ActiveWorkbook.Sheets("SheetName")

, затем ничего с ним не делая, переназначение

Set x = Worksheets("Work")

и опять ничего с ним не делаете?
Если предложенная мной строка кода

Intersect(x.Range("R3:T65536"), x.Cells.SpecialCells(xlCellTypeVisible)).Copy Sheets("Work").Range("R3")

находится именно в том месте, где Вы ее вставили, то макрос скопирует видимые ячейки из диапазона "R3:T65536" листа "SheetName" (в данном случае - x), в диапазон "R3..." листа "Work".

[SAS888]

Конечно, может это только часть Вашего макроса, но зачем Вы устанавливаете объект

Set x = ActiveWorkbook.Sheets("SheetName")

, затем ничего с ним не делая, переназначение

Set x = Worksheets("Work")

и опять ничего с ним не делаете?
Если предложенная мной строка кода

Intersect(x.Range("R3:T65536"), x.Cells.SpecialCells(xlCellTypeVisible)).Copy Sheets("Work").Range("R3")

находится именно в том месте, где Вы ее вставили, то макрос скопирует видимые ячейки из диапазона "R3:T65536" листа "SheetName" (в данном случае - x), в диапазон "R3..." листа "Work".

[Flangini]

Всё я понял!!!
Всё работает, замечательно, спасибо огромное!!!