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

Question

我在下面提到的格式的第 A.as 列中有村庄名称

VILLAGE
Campbelbay
Carnicobar
Champin
Chowra
Gandhinagar
Kakana
Kapanga

使用这种格式，我在工作簿中有大约 700 张纸。我需要在列(单元格)Q1中将相同的格式转换为下面提到的格式。

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

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

我对VB没有太多了解。

以下是适用于 Sheet1 的代码： 裁判：

宏以复制和转置新工作表中每七行和过去

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