Excel VBA копирует-вставляет только видимые отфильтрованные значения из одного столбца в другой

#excel #vba #loops #copy-paste

#превосходить #vba #петли #копировать-вставить

Вопрос:

Я пытаюсь скопировать-вставить только видимые отфильтрованные значения (даты) из столбца «B» в столбец «Y». (В отфильтрованном состоянии я могу копировать только небольшие части столбца «B» в «Y».)

введите описание изображения здесь

Я попытался сделать это с помощью приведенного ниже макроса. К сожалению, это не работает, потому что он копирует все (также не отфильтрованные значения) из столбца «B» в «Y», и я хочу сохранить не отфильтрованные данные в «Y».

 x = 4 Do While Cells(x, 1).Value lt;gt; "" Cells(x, 25).Value = Cells(x, 2).Value x = x   1 Loop   

Я также пробовал варианты, подобные приведенным ниже, но они также копируют только часть столбца B или код выдает ошибки.

 Range(Cells(4, 2), Cells(Range("B" amp; Rows.Count).End(xlDown).Row, 2)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range (Cells(4, 25).PasteSpecial(xlPasteAll)) ' Range("Y4").PasteSpecial(xlPasteAll))   

У кого-нибудь есть идеи, как я могу это решить? Спасибо.

Комментарии:

1. Не могли бы вы поделиться полным кодом, чтобы мы могли опираться на него?

2. привет, VBasic2008, это те подстановки, с которыми я работаю, они предназначены только для копирования ячеек из одного столбца в другой

Ответ №1:

Скопируйте отфильтрованные данные в Другой столбец

 Option Explicit  Sub CopyToY()    Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific    ' First Cell of the Data Range (in the row below headers)  Dim fCell As Range: Set fCell = ws.Range("B4")  ' Last Cell of the Filtered Range  Dim lCell As Range: Set lCell = ws.Range("B" amp; ws.Rows.Count).End(xlUp)  ' If no filtered data, the last cell will be the header cell, which  ' is above the first cell. Check this with:  If lCell.Row lt; fCell.Row Then Exit Sub ' no filtered data    ' Range from First Cell to Last Cell  Dim rg As Range: Set rg = ws.Range(fCell, lCell)    ' Filtered Data Range  Dim frg As Range: Set frg = rg.SpecialCells(xlCellTypeVisible)    ' Area Range  Dim arg As Range    For Each arg In frg.Areas  ' Either copy values (more efficient (faster))...  arg.EntireRow.Columns("Y").Value = arg.Value  ' ... or copy values, formulas and formatting  'arg.Copy arg.EntireRow.Columns("Y")  Next arg    MsgBox "Filtered data copied to column ""Y"".", vbInformation   End Sub  

Комментарии:

1. вау, это работает очень эффективно, thnx 🙂