Question

我在下面提到的格式

栏中有村名

VILLAGE
Campbelbay
Carnicobar
Champin
Chowra
Gandhinagar
Kakana
Kapanga

使用这种格式，我在工作簿中有大约700张。我需要在Column（cell）Q1中转换为下面提到的格式。

Campbelbay,Carnicobar,Champin,Chowra,Gandhinagar,Kakana,Kapanga

我有一个宏代码适用于8个单元格和一个工作表，有人可以帮助我将这个宏应用于所有具有自动选择行号的工作表。例如，Sheets1有30行，sheet2有50行，n有n行。

我对VB没有太多的了解。

以下是适用于Sheet1的代码：价：

macro to copy and transpose every seventh row and past in new sheet

Public Sub TransposeData()
    Dim LastRow As Long
    Dim NextRow As Long
    Dim i As Long

    Application.ScreenUpdating = False

    With Worksheets("Sheet1")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastRow Step 8
            .Cells(i, "A").Resize(8).Copy
            NextRow = NextRow + 1
            .Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, transpose:=True
        Next i

        .Rows(NextRow + 1).Resize(LastRow - NextRow).Delete
        .Columns(1).Delete
    End With

    Application.ScreenUpdating = True
End Sub

Answer 1

您需要循环工作表集worksheets并使用.end之类的内容

Sub test()

Dim w As Excel.Worksheet
Dim r As Excel.Range

For Each w In ThisWorkbook.Worksheets

    Set r = Range("a2", w.Range("a1").End(xlDown))
    w.Range("q1").Value = Join(Application.Transpose(r.Value), ",")

Next w

End Sub

无法确定你是否想要在Q中的同一张纸上，如果是这样你需要更改

w.Range("q1").Value = Join(Application.Transpose(r.Value), ",")

类似

worksheets("result").range("q1").end(xldown).offset(1,0)=

希望这有帮助，但没有完全测试最后一行。

由于

Answer 2

试试这个

Sub test()
    Dim w As Excel.Worksheet
    Dim r As Excel.Range

    For Each w In ThisWorkbook.Worksheets
        Set r = w.Range("a2", w.Range("a1").End(xlDown))
        w.Range("q1").Value = Join(Application.Transpose(r), ",")
    Next w
End Sub

用于复制和转置Cell Q1列中每一行和过去的宏

2 个答案: