過濾數據集時未粘貼的複製功能

我有以下代碼，用於複製活動行，並在數據末尾的第一個空白處或可用行處粘貼多次。該代碼提示用戶指定在數據末尾粘貼複製行的次數。但是，如果在某個特定字段上過濾了正在使用的數據集，則它無法正常工作。相反，它會粘貼已過濾數據中的現有數據。例如，如果行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

過濾數據集時未粘貼的複製功能

回答

相關問題