將單元格值從一張表復制到另一張表，並將其粘貼到具有特定值的單元格附近

Question

我的工作中有一項固定任務，我需要將數字列表復制到另一張紙上。 在該表中，我需要將這些數字一一粘貼到具有特定值的單元格右側的單元格中（在列中重復）。 （請注意，目標表按該值排序 -"מודל תגובה" 並且有隱藏的行。

很難解釋，所以我希望圖像可以。

我試圖編寫合適的代碼，但我不斷收到不同的錯誤。 將單元格值復制到目標單元格時似乎會出現問題。

Dim i As Integer
i = 4

Do While IsEmpty(Cells(i, 1).Value) = False
    Worksheets(1).Select
    Cells(i, 1).Copy
    Worksheets(2).Select
    Cells.Find(What:="מודל תגובה", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -1).Activate

    If IsEmpty(ActiveCell.Value) = False Then
         Selection.FindNext(After:=ActiveCell).Activate
         ActiveCell.Offset(0, -1).Paste
    Else
         ActiveCell.Offset(0, -1).Select
         ActiveCell.Paste  
    End If

    i = i + 1
Loop

對不起，糟糕的代碼（字面意思是我的第一個宏）。

Answer 1

解決方案是僅循環通過過濾范圍的可見單元格。

在運行此代碼之前，請確保已針對"מודל תגובה"過濾目的地。 在運行此代碼之前，它需要看起來像您的第二張圖片。

Dim SourceSheet As Worksheet
Set SourceSheet = Worksheets(1)

Dim DestinationSheet As Worksheet
Set DestinationSheet = Worksheets(2)

Dim LastRow As Long
LastRow = DestinationSheet.Cells(DestinationSheet.Rows.Count, "B").End(xlUp).Row

Dim VisibleCells As Range
On Error Resume Next 'next line errors if no visible cells so we turn error reporting off
Set VisibleCells = DestinationSheet.Range("A2", "A" & LastRow).SpecialCells(xlCellTypeVisible)
On Error Goto 0 'turn error reporting on or you won't see if other errors occur

If VisibleCells Is Nothing Then  'abort if no cells are visible in the filter
    MsgBox "No cells to paste at"
    Exit Sub
End If

Dim SourceRow As Long
SourceRow = 4   'start row in your source sheet

Dim Cell As Range
For Each Cell In VisibleCells.Cells    'loop through visible cells
    Cell.Value = SourceSheet.Cells(SourceRow, "A").Value 'copy value
    SourceRow = SourceRow + 1  'incerease source row
Next Cell

確保使用工作表名稱定義DestinationSheet和SourceSheet 。

Answer 2

嘗試這個：

Dim i As Integer
Dim Last_Row as Long
Worksheets(1).Select
'The "1" Of the line below means that the variable gonna count the rows of the first column (A)
Last_Row = Application.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & Last_Row).Copy
Worksheets(2).Select
Range("A1").Select
ActiveSheet.Paste