Вставить Excel только в видимые столбцы - PullRequest
0 голосов
/ 12 января 2019

Надеюсь, у вас все хорошо. Я столкнулся с проблемой в своей книге Excel, так как не могу найти решение для вставки только в видимые столбцы. Я искал почти по всему Интернету и нашел только вставить только видимые строки. Ниже приведены SS и пример рабочего листа. Example Worksheet

Все, что я хочу сделать, это скопировать желтый диапазон и вставить его в синий диапазон (содержащий скрытые столбцы).

Ниже приведен код, который я нашел полезным для вставки в видимые строки

Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
For Each rng1 In InputRng
    rng1.Copy
    For Each rng2 In OutRng
        If rng2.EntireRow.RowHeight > 0 Then
            rng2.PasteSpecial
            Set OutRng = rng2.Offset(1).Resize(OutRng.Rows.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False
End Sub

Я пытался изменить его для работы со столбцами, но он работал так же, как и для строк, как показано ниже:

Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
For Each rng1 In InputRng
    rng1.Copy
    For Each rng2 In OutRng
        If rng2.EntireColumn.ColumnWidth > 0 Then
            rng2.PasteSpecial Transpose:=True
            Set OutRng = rng2.Offset(1).Resize(OutRng.Columns.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False
End Sub

Любая помощь будет принята с благодарностью.

1 Ответ

0 голосов
/ 12 января 2019

1001 * попробовать *

Sub CopyFilteredCells()

Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
Dim n As Integer
xTitleId = "Example"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
    For Each rng2 In OutRng
        If rng2.EntireColumn.ColumnWidth > 0 Then
           If rng2.EntireColumn.Hidden Then
           Else
                n = n + 1
                rng2 = InputRng.Cells(1, n)
            End If
        End If
    Next

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