Vba 根据用户输入复制范围并粘贴到另一个范围

您好，我是VBA新手，如果我的代码太疯狂/逻辑比需要的复杂，我很抱歉。如果能得到任何帮助，我将不胜感激。我正在尝试编写一个程序，它的工作原理如下：

**由于链接数量限制，图像被临时删除

我有一个表，其中包含10个单位值（分配给它们一个数字作为参考-就像一个代码）。每个单元对应于它自己的工作表，其中包含两个称为“输入”和“输出”的表。在与单位值和相应编号相同的表格中，有一个表格，您可以使用单位编号键入以下单位。我想做的是从相应单元的工作表中复制“out”表，并将其粘贴到相应工作表上指示的以下单元的“in”表中

我已经试着为此编写了一个程序——当我运行它时，我没有任何错误，但什么也没有发生。救命啊

Sub Reporting_Tails()
'Step 1:


Dim oreassay As Range
Set oreassay = Sheets("Ore").Range("B13:K13")
Dim cr1_in As Range
Set cr1_in = Sheets("Crusher 1").Range("B13:K13")
Dim cr2_in As Range
Set cr2_in = Sheets("Crusher 2").Range("B13:K13")
Dim bami_in As Range
Set bami_in = Sheets("Ball Mill").Range("B13:K13")
Dim romi_in As Range
Set romi_in = Sheets("Rod Mill").Range("B13:K13")
Dim cla_in As Range
Set cla_in = Sheets("Classifier").Range("B13:K13")
Dim ro_in As Range
Set ro_in = Sheets("Rougher").Range("B13:K13")
Dim cle_in As Range
Set cle_in = Sheets("Cleaner").Range("B13:K13")
Dim fi1_in As Range
Set fi1_in = Sheets("Filter 1").Range("B13:K13")
Dim fi2_in As Range
Set fi2_in = Sheets("Filter 2").Range("B13:K13")

Dim Tab_in(0 To 9) As Variant
Tab_in(0) = oreassay
Tab_in(1) = cr1_in
Tab_in(2) = cr2_in
Tab_in(3) = bami_in
Tab_in(4) = romi_in
Tab_in(5) = cla_in
Tab_in(6) = ro_in
Tab_in(7) = cle_in
Tab_in(8) = fi1_in
Tab_in(9) = fi2_in
'Step 2:

Dim cr1_out As Range
Set cr1_out = Sheets("Crusher 1").Range("B13:K13")
Dim cr2_out As Range
Set cr2_out = Sheets("Crusher 2").Range("B13:K13")
Dim bami_out As Range
Set bami_out = Sheets("Ball Mill").Range("B13:K13")
Dim romi_out As Range
Set romi_out = Sheets("Rod Mill").Range("B13:K13")
Dim cla_out As Range
Set cla_out = Sheets("Classifier").Range("B13:K13")
Dim ro_out As Range
Set ro_out = Sheets("Rougher").Range("B13:K13")
Dim cle_out As Range
Set cle_out = Sheets("Cleaner").Range("B13:K13")
Dim fi1_out As Range
Set fi1_out = Sheets("Filter 1").Range("B13:K13")
Dim fi2_out As Range
Set fi2_out = Sheets("Filter 2").Range("B13:K13")

Dim Tab_out(1 To 9) As Variant

Tab_out(1) = cr1_out
Tab_out(2) = cr2_out
Tab_out(3) = bami_out
Tab_out(4) = romi_out
Tab_out(5) = cla_out
Tab_out(6) = ro_out
Tab_out(7) = cle_out
Tab_out(8) = fi1_out
Tab_out(9) = fi2_out

'Step 3:

Dim Tab_report As Variant
Set Tab_report = Sheets("Crusher 1").Range("B13:K13")

'Step 4: set value in reporting table to variable
Dim i As Integer
For i = 1 To 10
Tab_report(i).Value = x
'Step 5: command the in table for i to copy and paste into the assigned out table range.
If x > 0 Then
'Tab_in(i).Copy ([Tab_out(x)])
Tab_in(i).Select
Selection.Copy
Tab_out(x).Select
Selection.Paste


End If
Next i
End Sub

下面是我正在使用的文件中的一些示例，以提供更好的解释

这是输入（注意，我在Ore的报告列中放了2，因为我想将“out”表值粘贴到破碎机1“in”表中。我不想将该表粘贴到任何地方的空白处：

这里是矿石和破碎机标签的例子。我希望这有助于你们理解我试图实现的目标！

---

未经测试，但类似的方法应该可以工作：

Sub Tester()
    'In and Out range addresses
    Const RNG_IN As String = "B13:K13"
    Const RNG_OUT As String = "B18:K18" 'for example

    Dim rw As Range, tbl As Range, v, f As Range
    Dim rngCopy As Range, rngPaste As Range 'EDIT: added

    'the "control table" (code/unit/reports to)
    Set tbl = ActiveSheet.Range("A2:C11") 'for example

    'loop over each row in the control table
    For Each rw In tbl.Rows

        'is there a value for "Reports to" ?
        v = rw.Cells(3).Value
        If v <> "" Then
            'If Yes, find the matching sheet
            Set f = tbl.Columns(1).Find(What:=v, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                'got a match, so copy OUT >> IN
                With ThisWorkbook
                   'EDIT
                   Set rngCopy = .Sheets(rw.Cells(2).Value).Range(RNG_OUT)
                   Set rngPaste = .Sheets(f.Offset(0, 1).Value).Range (RNG_IN)
                   rngCopy.Copy rngPaste

                End With
            End If
        End If

    Next rw

End Sub

子测试仪（）
'范围内和范围外地址
常量RNG_的形式为String=“B13:K13”
例如，Const RNG_OUT为String=“B18:K18”
变暗rw As范围、tbl As范围、v、f As范围
Dim rngCopy As Range，rngPaste As Range'编辑：已添加
“控制表”（代码/单位/报告对象）
例如，设置tbl=ActiveSheet.Range（“A2:C11”）”
'循环控制表中的每一行
对于tbl.行中的每个rw
'是否有“报告到”的值？
v=rw.单元格（3）.值
如果v“那么
'如果是，请查找匹配的工作表
设置f=tbl.Columns（1）.Find（What:=v，LookIn:=xlValues，lookat:=xlWhole）
如果不是的话，那么f什么都不是
'找到匹配项，请在中复制>>
使用此工作簿
"编辑"
设置rngCopy=.Sheets（rw.Cells（2.Value）.Range（RNG_OUT）
设置rngPaste=.Sheets（f.Offset（0，1）.Value）.Range（RNG_IN）
rngCopy.Copy rngPaste
以
如果结束
如果结束
下一个rw
端接头

---

注意：如果从控制表中删除“reports to”，则不会从“In”表中清除以前粘贴的数据。

因此，不会执行粘贴操作？如果将该部分更改为

如果x>0，则Tab_In（i）。复制Tab_out（x）如果

，则结束？当您使用

F8

遍历该部分时会发生什么情况？它没有做任何事情，或者它运行了代码，您只是看不到任何更新？是-否粘贴。当我调试时，它在步骤1停止，我正在定义范围，并说运行时错误9-下标超出范围。您知道我会怎么做吗修复此问题？如果要存储对实际范围（而不是其值）的引用，则更改copy语句也会产生相同的结果。

Set Tab_in（0）=oreassay

（等）在arrayWhich行中？字面上是第一个

集合

？而且，您确实有这样命名的工作表对吗？编辑：哦，我想@Tim在上面。这似乎是一个非常长的方法来做一些非常简单的事情（尽管我没有完全理解最后一部分…）谢谢你的帮助。我在我的原始帖子的末尾添加了一些额外的信息。这是否使目标更加明确？你提供的代码仍然会被推荐吗？我将不得不查找很多语法，因为我对其中的一些语法还不够熟悉，所以目前还无法遵循。我已经尝试了你发布的代码，但似乎没有o挂在以下行：

Set tbl=ActiveSheet.Range（“A2:C11”）“例如”

我得到一个424运行时错误，在错误上方悬停表示tbl=nothing。你知道我如何解决这个问题吗？再次感谢你的帮助。这是一个非常简单的范围分配-应该可以很好地工作。我不知道这是什么问题。代码现在实际上可以很好地工作，只是在粘贴时挂起了。我明白了at选择正确的范围-但粘贴前会出错。突出显示的行是

.Sheets（rw.Cells（2）.Value）.range（RNG_OUT）.Copy u.Sheets（f.Offset（0，1）.Value）.range（RNG_IN）

，错误是需要“424”对象。请参阅上面的编辑-这将有助于解决问题