过滤数据集时未粘贴的复制功能

我有以下代码，用于复制活动行，并在数据末尾的第一个空白处或可用行处粘贴多次。该代码提示用户指定在数据末尾粘贴复制行的次数。但是，如果在某个特定字段上过滤了正在使用的数据集，则它无法正常工作。相反，它会粘贴已过滤数据中的现有数据。例如，如果行699由于应用了过滤器选择而不可见，并且数据在行700结束，所以701将是第一个空白行，它将粘贴在行699上。但是，当用户保存在之间。有关如何解决此问题的任何想法？过滤数据集时未粘贴的复制功能

Sub Transfer() 

Application.ScreenUpdating = False 

Dim lastrow As Long 
lastrow = Sheets("ForecastedMovement").Range("A65536").End(xlUp).Row ' or + 1 

On Error GoTo Finish 
lngRows = CLng(InputBox("How many rows do you wish to add?")) 
lngNextRow = Range("A" & Rows.Count).End(xlUp).Row + 1 

Range("A" & ActiveCell.Row & ":BX" & ActiveCell.Row).Copy 
Range("A" & lastrow + 1 & ":BX" & lastrow + lngRows).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Finish: 
If Err.Number <> 0 Then MsgBox Prompt:="Please ensure you only enter numeric values!" 

Application.ScreenUpdating = True 

End Sub

来源

2017-10-04 NeilD137

只是作为小费，使用'Application.InputBox'，而不是'InputBox'。然后，您可以强制用户输入一个数字，而不是使用“On Error”。即**'Application.InputBox（“你想添加多少行？”，类型：= 1）**。这将只接受一个数字 – Zac

Sub Transfer() 

    Dim sht As Worksheet 
    Dim lastrow As Long, lngRows 

    Application.ScreenUpdating = False 

    Set sht = Sheets("ForecastedMovement") 

    lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1 
    'account for filtered rows at end of dataset 
    Do While Application.CountA(sht.Rows(lastrow)) > 0 
     lastrow = lastrow + 1 
    Loop 

    On Error GoTo Finish 
    lngRows = CLng(InputBox("How many rows do you wish to add?")) 

    ActiveCell.EntireRow.Range("A1:BX1").Copy 

    sht.Cells(lastrow, 1).Resize(lngRows).PasteSpecial Paste:=xlPasteValues 

Finish: 
    If Err.Number <> 0 Then MsgBox Prompt:="Please ensure you only enter numeric values!" 

    Application.ScreenUpdating = True 

End Sub

来源

2017-10-04 16:55:48

这完美的威廉姆斯先生！ – NeilD137

过滤数据集时未粘贴的复制功能

回答

相关问题