求救，求救 Excel添加固定单元格下移

abucike

有附件，就是想 如果有固定按钮，直接添加最好，如果选中插入，再清楚很麻烦，因为数据多了，（因为有不同的人操作）怕误操作 影响其他行列的数据排列。

haoma125

1. 
   
2. Sub 插入()
   
3.     Dim i&
   
4.     Dim myArray(3, 3)
   
5.     myArray(0, 0) = "名称": myArray(0, 1) = "a": myArray(0, 2) = "b": myArray(0, 3) = "c":
   
6.     myArray(1, 0) = "数据1": myArray(1, 1) = "": myArray(1, 2) = "": myArray(1, 3) = "":
   
7.     myArray(2, 0) = "数据2": myArray(2, 1) = "": myArray(2, 2) = "": myArray(2, 3) = "":
   
8.     myArray(3, 0) = "数据3": myArray(3, 1) = "": myArray(3, 2) = "": myArray(3, 3) = ""
   
9.     i = Cells(Rows.Count, 1).End(xlUp).Row + 1
   
10.     If Cells(Rows.Count, 1).End(xlUp).Row + 1 = 2 Then
    
11.         
    
12.         Range(Cells(i - 1, 1), Cells(i + 2, 4)) = myArray                           '要移动行列就改cells（i-1,1)，行是i-1,列是1就是第一列
    
13.         Range(Cells(i - 1, 1), Cells(i - 1, 4)).Interior.Color = RGB(230, 184, 183)
    
14.         Range(Cells(i - 1, 1), Cells(i + 2, 1)).Interior.Color = RGB(230, 184, 183)
    
15.         Range(Cells(i, 2), Cells(i + 2, 4)).Interior.Color = RGB(218, 238, 243)
    
16.         Else
    
17.         Range(Cells(i, 1), Cells(i + 3, 4)) = myArray
    
18.         Range(Cells(i, 1), Cells(i, 4)).Interior.Color = RGB(230, 184, 183)
    
19.         Range(Cells(i, 1), Cells(i + 3, 1)).Interior.Color = RGB(230, 184, 183)
    
20.         Range(Cells(i + 1, 2), Cells(i + 3, 4)).Interior.Color = RGB(218, 238, 243)
    
21.     End If
    
22. End Sub
    

复制代码

abucike

请教高人帮助下

abucike

haoma125 发表于 2020-6-6 15:45

  高手搞不来，这个是放在哪里~

haoma125

abucike 发表于 2020-6-14 18:31
高手搞不来，这个是放在哪里~

宏，ALT+F11

我的影子不见了

简单做的话就是把名称那一行复制到数据下面，再把数据列复制到名称下面。
在VBA里，[e65536].End(3).Row就是E列最后一个非空单元格所在行数，在这个例子里就是E13所在行数，把E6:H6复制到下一行的E14，E7:E9复制到再下行的E15,插入后，E列最后一个非空单元格变为E17，在此运行宏就会把E6:H6复制到E18，E7:E9复制到E19,依次类推······ 实际使用时可以根据你复制的内容所在位置更换代码中对应的单元格。
vba代码：
Sub insert1()
Dim irow As Integer
irow = [e65536].End(3).Row
Range("e6:h6").Copy Range("e" & irow + 1)
Range("e7:e9").Copy Range("e" & irow + 2)
End Sub