Excel VBA转置每个空单元格的连续范围

我有一个excel文件连续单元格的行分开的行例如：名称地址电话传真networking – EMPTY行 – 名称地址1地址2电话网 – EMPTY行 – …

我需要采取每个连续的范围和转置它在每个范围右侧的列其实我需要select范围的手，并运行一个快捷macros转置它与此代码：

ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 

你可以帮助我在vba中select第一个范围和转置它，然后采取空行后面的下一个范围，并转置，直到文件的结尾？

Answer 1

这个怎么样？ 我假设你的数据看起来像这样（列A和B）

 Name Batman Address 123 Batcave Drive Phone [phone] Fax [phone] Web www.batman.com Name 1 Superman Address 1 321 Krypton Lane Phone [phone] Fax [phone] Web 1 www.superman.com 

使用这个macros将导致数据被转置，从列C开始：

  Sub test() Dim lastRangeRow As Integer, lastRow As Integer, i As Integer, copyCol As Integer Dim noOfReports As Integer copyCol = 2 'Column "B" has the info you want to transpose. Change if different lastRow = Sheets("Sheet1").UsedRange.Rows.Count ' How many blank cells are there? This will tell us how many times to run the macro noOfReports = Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).Cells.Count + 1 i = 1 Do While i <= lastRow 'until you reach the last row, transpose the data With Sheets("Sheet1") lastRangeRow = .Cells(i, copyCol).End(xlDown).Row .Range(.Cells(i, copyCol), .Cells(lastRangeRow, 2)).Copy .Cells(i, copyCol + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True If lastRangeRow >= lastRow Then Exit Do Else i = .Cells(i, copyCol).End(xlDown).End(xlDown).Row End If End With Loop MsgBox ("Done!") Application.CutCopyMode = False End Sub 

如果你提供更多的信息，我们可以调整。 你想要“B”列最后消失吗？ 你想转换“标题”（“名称”，“地址”，“电话”等）？