用于复制和粘贴可见单元格的宏

时间:2015-09-09 01:27:34

标签: excel vba excel-vba

有没有人碰巧有一个可以做到这一点的宏?我只需复制一列可见单元格并粘贴到下一列。如果这是一个愚蠢的问题我会道歉,但我恰好对这些东西一无所知。我看过每一个地方,但我找不到一个似乎有效的地方。我有一个去,但它只复制一些数字。

这是代码

 <div class="logo">
     <img  src="resources/images/logo.png" alt=""/> 
  </div> 

.logo{
-webkit-animation-name: example; /* Chrome, Safari, Opera */
-webkit-animation-duration: 4s; /* Chrome, Safari, Opera */
-webkit-animation-delay: 1s; /* Chrome, Safari, Opera */
-webkit-animation-iteration-count: infinite ;
-webkit-animation-direction: alternate;
-webkit-animation-timing-function: linear;
animation-name: example;
animation-duration: 4s;
animation-delay: 1s;
animation-iteration-count: infinite;
animation-direction: alternate;     
animation-timing-function: linear;}

@-webkit-keyframes example {
from {
    margin-left:  -200px;
    transform: scaleX(1);
}
to {
    margin-left: 200px;
    transform: scaleX(-1);      
}}

@keyframes example {    
 from {
    margin-left:  -200px;
    transform: scaleX(1);
}
to {
    margin-left: 200px;       
    transform: scaleX(-1);
}}

enter image description here

^上面的图片是在我运行宏之前。注意隐藏的行。我需要将这些数字复制到下一栏。

enter image description here

^此图像是在我运行宏之后。我不明白为什么只有一些数字在复制。隐藏的行包含数字3和6.为什么它们在结果中,而不是可见数字?我只是需要它来复制所看到的内容。

3 个答案:

答案 0 :(得分:2)

即使您手动执行此操作,也无法以此方式执行 你必须循环才能得到你想要的东西。所以试一试。

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

你的结果很奇怪,为什么它会以相反的顺序复制值 我能理解它是否复制了B1以后的所有可见单元格,而不是值的反转 无论如何,首先尝试以上,如果它让你去。

答案 1 :(得分:1)

我不确定你的输出顺序是否相反,但对我来说你的代码是有效的:

paramIndexes[k]

enter image description here

答案 2 :(得分:0)

请使用此代码!就像魅力一样:)

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