将单元格值从一张表复制到另一张表，并将其粘贴到具有特定值的单元格附近

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