VBA將列名從一張紙復制到所有其他紙

Question

我被困在一個代碼上

運行時錯誤424，需要對象

該代碼基本上是從第一個工作表名稱“ Generate”復制一列，並將復制的列轉置到除“ Generate”之外的所有其他活動工作表的標題行中。

誰能幫我解決錯誤？

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

Answer 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