如何根据列或单元格的值复制一行

我想在Excel中使用VBA复制行并将列合并为一个。

下面的VBA代码隐藏了一些列。 我需要帮助编辑我的代码以显示所有列(复制col A到col Q)。

这就是原始数据的样子 在这里输入图像说明

这是我想如何结束 在这里输入图像说明

这是我如何得到使用下面列出的代码( 问题 :不会显示或复制列B到Col P)

在这里输入图像说明

我想显示A和Q之间的所有列。下面的代码隐藏除第一个和合并之外的所有列(列A和列B上的合并列)。

Sub SortMacro() Dim SourceSheet As Worksheet Dim OutSheet As Worksheet Set SourceSheet = ActiveSheet Set OutSheet = Sheets.Add With SourceSheet Out_i = 1 For r = 1 To .Cells(Rows.Count, 1).End(xlUp).Row For i = 17 To 20 'or For each i in Array(17,18,20) OutSheet.Cells(Out_i, 1) = .Cells(r, 1) OutSheet.Cells(Out_i, 2) = .Cells(r, i) Out_i = Out_i + 1 Next Next End With End Sub 

谢谢!

这是我对你所需要的解释。 我已经添加了一个循环来复制列A:P到每一个新的行

 Sub SortMacro() Dim SourceSheet As Worksheet Dim OutSheet As Worksheet Set SourceSheet = ActiveSheet Set OutSheet = Sheets.Add With SourceSheet Out_i = 1 For r = 1 To .Cells(Rows.Count, 1).End(xlUp).Row ' Create a new row for each column entry in Q:T For i = 17 To 20 ' Check the cell isn't empty before creating a new row If (.Cells(r, i).Value <> "") Then ' Copy columns A:P For j = 1 To 16 OutSheet.Cells(Out_i, j) = .Cells(r, j) Next j ' Copy the current column from Q:T OutSheet.Cells(Out_i, 17) = .Cells(r, i) Out_i = Out_i + 1 End If Next i Next r End With End Sub