重复VBA代码并根据其他工作表更改值

时间:2017-05-18 11:07:49

标签: excel vba excel-vba loops

我正在尝试使用以下代码自动化Excel工作表。它适用于我需要它的第一部分,但我无法弄清楚下一部分。

我需要为名为Materials的工作表中的每个值重复此代码。每个单元格包含不同的材料编号。用于第一组数据Result(A2)的材料编号将被材料表中的A列的下一个可用值覆盖,直到最后一个单元格为止。

所以基本上这会创建第一个集合,我想在材料表中的A列中复制并粘贴更新的值。希望这是有道理的。

Sub Test2()

Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range
    Set sh4 = Sheets("Template")
    Set sh5 = Sheets("Result")
    lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = sh4.Range("A2:E2" & lr)
        rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2)

        Sheets("Materials").Select
        Range("A2").Select
        Selection.Copy
        Sheets("Result").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("Result").Select

Dim lastrow As Long
    lastrow = Worksheets("Result").Range("E65536").End(xlUp).Row
With Worksheets("Result").Range("A2")
    .AutoFill Destination:=Range("A2:A" & lastrow&)
End With

End Sub

1 个答案:

答案 0 :(得分:0)

这是一个猜测,因为我不清楚你的照片到底是什么,并且似乎与你的实际文件有所不同

Sub Test2()

Dim sh4 As Worksheet, sh5 As Worksheet, rng As Range, r As Range

Application.ScreenUpdating = False

Set sh4 = Sheets("Template")
Set sh5 = Sheets("Result")
Set rng = sh4.Range("B2:E2" & lr)

With Sheets("Materials")
    For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        sh5.Range("A" & Rows.Count).End(xlUp)(2).Offset(, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        sh5.Range("A" & Rows.Count).End(xlUp)(2).Resize(rng.Rows.Count).Value = r.Value
    Next r
End With

Application.ScreenUpdating = True

End Sub