vba 仅复制和粘贴可见单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/32469561/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copying and pasting visible cells only
提问by Kevin Sanders
I need to copy a column of visible cells and paste to the next column over.
我需要复制一列可见单元格并粘贴到下一列。
I can't find a macro that works. I had one going, but it only copies some numbers.
我找不到有效的宏。我有一个去，但它只复制了一些数字。
Here is the code
这是代码
Sub TryMe()
Sheet1.Range("A1:A100").SpecialCells(xlCellTypeVisible).Copy _
Destination:=Range("A1").Offset(ColumnOffset:=1)
End Sub
This image is before I run the macro. Notice the rows that are hidden. I need these numbers to copy to the next column.
这个图像是在我运行宏之前。注意隐藏的行。我需要将这些数字复制到下一列。
This image is after I run the macro. I don't understand why only some of the numbers are copying. The hidden rows contain the numbers 3 and 6. Why are they in the outcome, but not the visible numbers? I need to copy what is seen.
这个图像是在我运行宏之后。我不明白为什么只有一些数字在复制。隐藏行包含数字 3 和 6。为什么它们在结果中，而不是可见数字？我需要复制看到的内容。
回答by L42
You can't do it that way even if you manually do it.
You will have to loop to get what you want. So give this a try.
即使您手动执行此操作，也无法这样做。
你必须循环才能得到你想要的。所以试试这个。
Dim c As Range
For Each c In Sheet1.Range("A1:A100").SpecialCells(xlCellTypeVisible)
If Len(c) <> 0 Then c.Offset(0, 1) = c
Next
The odd thing about your result is why does it copy the values in reverse order.
I can understand if it copies all the visible cells at B1 onwards, but not the reversal of values.
Anyways, try above first if it gets you going.
结果的奇怪之处在于为什么它以相反的顺序复制值。
我可以理解它是否会复制 B1 处的所有可见单元格，而不是值的反转。
无论如何，如果它能让你前进，请先尝试上面。
回答by paul bica
I'm not sure how you have the output in reverse order, but for me your code works:
我不确定您如何以相反的顺序输出，但对我来说，您的代码有效：
Sub TryMe()
'1. some visible values in col A will be will be hidden in col B by hidden rows
Sheet1.Range("A1:A10").SpecialCells(xlCellTypeVisible).Copy _
Destination:=Range("A1").Offset(ColumnOffset:=1)
'2. all visible values in col A will be will be visible bellow
Sheet1.Range("A1:A10").SpecialCells(xlCellTypeVisible).Copy _
Destination:=Range("A11").Offset(ColumnOffset:=1)
End Sub
回答by Jappa Langua
Use this code guys! Works like a charm :)
使用此代码伙计们！奇迹般有效 ：）
Sub PasteToFilteredCells()
Dim rng1 As Range
Dim rng2 As Range
Dim InputRng As Range
Dim OutRng As Range
Dim n As Integer
n = 0
Dim x As Integer
Dim c As Integer
c = 0
xTitleId = "Paste Buddy"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Copy Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Paste Range:", xTitleId, Type:=8)
x = InputRng.SpecialCells(xlCellTypeVisible).Count
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
For Each rng1 In InputRng
If rng1.EntireRow.RowHeight > 0 Then
rng1.Copy
c = c + 1
Else
GoTo NextIte
End If
Do While (c < (x + 1))
If (OutRng.Offset(n, 0).EntireRow.RowHeight > 0) Then
OutRng.Offset(n, 0).PasteSpecial
n = n + 1
GoTo NextIte
Else
n = n + 1
End If
Loop
NextIte:
Next rng1
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
