VBA将列名从一个工作表复制到所有其他工作表

时间:2018-04-15 02:48:26

标签: vba excel-vba loops for-loop excel

我坚持使用

代码
  

运行时错误424,需要对象

代码基本上是从第一个工作表名称复制一个列"生成"并将复制的列转置到所有其他活动工作表上的标题行,但"生成"。

有人可以帮我解决错误吗?

Sub Test()   
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Generate" Then
  Worksheets("Generate").Range("B2:B42").Copy
  ActiveWorksheet.Range("A" & Rows.Count).End(xlUp).Offset(1,  0).PasteSpecial Transpose:=True
End If
Next ws

End Sub

1 个答案:

答案 0 :(得分:1)

首先尝试将列标题标签收集到数组中。

sub test()
    dim hdrs as variant, w as long

    with worksheets(1)
        hdrs = application.transpose(.range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup)).value2)
    end with

    for w=2 to worksheets.count
        with worksheets(w)
            .cells(1, "A").resize(1, ubound(hdrs)) = hdrs
            '.cells(.rows.count, "A").end(xlup).offset(1, 0).resize(1, ubound(hdrs)) = hdrs
        end with
    next w
end sub

'alternate by worksheet name

sub test()
    dim hdrs as variant, w as long

    with worksheets("Generate")
        hdrs = application.transpose(.range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup)).value2)
    end with

    for w=1 to worksheets.count
        if lcase(worksheets(w).name) <> "generate" then
            with worksheets(w)
                .cells(1, "A").resize(1, ubound(hdrs)) = hdrs
                '.cells(.rows.count, "A").end(xlup).offset(1, 0).resize(1, ubound(hdrs)) = hdrs
            end with
        end if
    next w
end sub