Question

希望对此有更多的关注-以前我只是在个人项目上涉猎过VBA，但在过去已经取得了成功！但是，这是一个笨拙的事情，从未做过如此复杂的事情。我正在使用电子表格-第一个选项卡是主列表，上面有多个问题-以下选项卡是不同的问卷，它们以不同的顺序使用问题。

我正在尝试创建一个宏，该宏将搜索其他选项卡并比较包含问题＃的“ Q”列。如果选项卡上有一个与主列表匹配的Q单元格，我想从主列表行复制A＃：Q＃并将其粘贴到该工作表上。在该网站上进行了大量搜索之后，这是我的搜索范围：

Sub Refresh()

Refresh Macro

Keyboard Shortcut: Ctrl+r
  Dim wM As Worksheet, wR As Worksheet
  Dim r1 As Range, R2 As Range
  Dim cel1 As Range, cel2 As Range
  Dim LastRow As Long
  Application.ScreenUpdating = False

Set wR = ActiveSheet
Set wM = ActiveSheet.Next

With wR
  Set R2 = .Range("Q1", .Cells(.Rows.Count, .Columns("Q:Q").Column).End(xlUp))
End With

With wM
  Set r1 = .Range("Q1", .Cells(.Rows.Count, .Columns("Q:Q").Column).End(xlUp))
End With

LastRow = 1


On Error Resume Next
For Each cel1 In r1
  With Application
    Set cel2 = .Index(R2, .Match(cel1.Value, R2, 0)) 'find match in active page
    If Err = 0 Then
        copyResult cel2, LastRow 'copy result to next page
    End If
    Err.Clear
    LastRow = LastRow + 1
End With
Next cel1

End Sub

Sub copyResult(cel As Range, row As Long)
  Dim ws As Worksheet
  Set ws = ActiveSheet.Next

  cel.EntireRow.Copy ws.Cells(row, 1)

End Sub

我被困在两个地方： 1.试图找到一种方法来触发“ wM”的下一张表进行更新 2.获取copyResult部分以仅复制部分行-每个选项卡上都有一个note部分，不应覆盖。我尝试做cel.Range（“ A”和cel.row：“ Q”和cel.row）。复制，但是没有用。

欢迎所有想法-预先感谢！

根据匹配条件将单元格复制/粘贴到多张纸上的不同行

0 个答案: