如图：
有两个区域，区域(U1:AX6)、区域（J1:R40),这两个区域内单元格数值均由函数获得，粘贴时需要用“选择性粘贴”！粉红色底纹范围为1-30，且一一对应。区域(U1:AX6)内的数字只会以整列的形式出现，如AR列，如果AR1有数字，则AR1-AR6均有数字；若AA为空白，则AA1-AA6均为空白。左侧11-40行，若J列有数字，则J-Q列均会有数字。我想将区域(U1:AX6)内的非空数字复制粘贴到另一张表“Sheet6”里面，按顺序排列紧凑，同时左侧相对应的单元格的数字也复制粘贴在同一张表里面，如何通过宏实现？效果如图
运行一次宏之后，第二次运行宏的时候，复制粘贴的内容不要将上一次的内容覆盖，而是按顺序紧凑的排列在一起，求哪位高高手帮忙。
我自己使用的方法是先用函数将符合要求的数值筛选出来，然后自己找了一串宏代码：
Sub Macro2()'' Macro2 Macro' 宏由 duaiyue 录制，时间: 2014/5/18'
' ActiveWindow.SmallScroll Down:=6 Range("L43:R72").Select ActiveWindow.SmallScroll Down:=-6 Selection.Copy Sheets("Sheet6").Select Range("A1").Select Dim colu As Integer colu = Range("a:a").SpecialCells(xlCellTypeConstants).Count Range("a" & colu + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select ActiveWindow.SmallScroll Down:=-60 Range("U1:AX6").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet6").Select ActiveWindow.SmallScroll Down:=-3 Range("J1").Select colu = Range("j:j").SpecialCells(xlCellTypeConstants).Count Range("j" & colu + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True ActiveWindow.SmallScroll Down:=3 Sheets("Sheet1").Select ActiveWindow.SmallScroll Down:=-12End Sub
产生的问题是，每次抓取复制的结果都包含很多的“空白单元格”，该如何实现？求教
我有一张表，如图：
有两个区域，区域(U1:AX6)、区域（J11:R40),这两个区域内单元格数值均由函数获得，复制后，粘贴时需要用搜索“选择性粘贴”！说明：粉红色底纹范围为1-30，且一一对应。区域(U1:AX6)内的非空白数字只会以整列的形式出现，如AG列，如果AG1有数字，则AG1-AG6均有数字；若AA为空白，则AA1-AA6均为空白。区域（J11:R40),11-40行，若J列有数字，则J-Q列均会有数字。
我想将区域(U1:AX6)内的非空数字复制粘贴到另一张表“Sheet6”里面，按顺序排列紧凑，注意：次区域内的非空数字可能同时出现多列，比如编号为13与编号为15甚至编号为23所在的列内同时出现数字！与此同时区域（J11:R40)相对应的单元格的数字也复制粘贴在同一张表“Sheet6”里面，如何通过宏实现？效果如图
运行一次宏之后，第二次运行宏的时候，复制粘贴的内容不要将上一次的内容覆盖，而是按顺序紧凑的排列在一起，求哪位高高手帮忙。
现在是否明白了？
HH1 = Sheets("Sheet6").Range("A65536").End(xlUp).Row
HH2 = Sheets("Sheet6").Range("J65536").End(xlUp).Row
If Sheets("Sheet6").Range("A1") <> "" Then HH1 = HH1 + 1
If Sheets("Sheet6").Range("J1") <> "" Then HH2 = HH2 + 1
'------------------------------
Hs = 11: L1 = 10: L2 = 17
Ls = 21: H1 = 1: H2 = 6
'------------------------------
For I = 1 To 30
H = Hs + I - 1
If Cells(H, L1) <> "" Then
LL1 = 1
For L = L1 To L2
Sheets("Sheet6").Cells(HH1, LL1) = Cells(H, L)
LL1 = LL1 + 1
Next
HH1 = HH1 + 1
End If
L = Ls + I - 1
If Cells(H1, L) <> "" Then
LL2 = 10
For H = H1 To H2
Sheets("Sheet6").Cells(HH2, LL2) = Cells(H, L)
LL2 = LL2 + 1
Next
HH2 = HH2 + 1
End If
Next
End Sub追问
这是运行3次宏后的结果：
只有一点没有做好，我不是要把区域（J11:R40)内的所有数值粘贴过去。区域(U1:AX6)中的所有非空单元格所在的列号（如上图编号为13），找出区域（J11:R40)中相对应的编号，复制粘贴，做到一一对应。
比如最上面的两个图，区域（J11:R40)中非空单元格为AG列（编号13），在区域（J11:R40)中找到相同的编号13，复制、粘贴，获得最后一个图的效果
Sub 数据整理()
K = 30
'------------------------------
HHH1 = Sheets("Sheet6").Range("A65536").End(xlUp).Row
HHH2 = Sheets("Sheet6").Range("J65536").End(xlUp).Row
If Sheets("Sheet6").Range("A1") "" Then HHH1 = HHH1 + 1
If Sheets("Sheet6").Range("J1") "" Then HHH2 = HHH2 + 1
LLL1 = 1
LLL2 = 10
'------------------------------
H1 = 1: H2 = 6
L1 = 21: L2 = L1 + K - 1
'------------------------------
HH1 = 11: HH2 = HH1 + K - 1
LL1 = 10: LL2 = 17
'------------------------------
If Application.WorksheetFunction.CountA(Range(Cells(H1, L1), Cells(H1, L2))) > 0 Then
L = Cells(H1, 256).End(xlToLeft).Column
编号 = L - L1 + 1
HH = HH1 + 编号 - 1
For LL = LL1 To LL2
Sheets("Sheet6").Cells(HHH1, LLL1) = Cells(HH, LL)
LLL1 = LLL1 + 1
Next
For H = H1 To H2
Sheets("Sheet6").Cells(HHH2, LLL2) = Cells(H, L)
LLL2 = LLL2 + 1
Next
End If
End Sub
这是运行后的结果，
绿色底纹缺少一位数字，同时，区域(U1:AX6)内的数字完全没有了。同时，仔细看了一下，提取的数字编号固定为30，为什么会这样？给力啊
