请教一下关于把第一行全部填写上工作表的名称

想飞的牛

Sub 合并工作表1()
Application.ScreenUpdating = False
Dim row1, x
For i = 1 To Sheets.Count
    If Sheets(i).Name <> ActiveSheet.Name Then
      x = ActiveSheet.Range("B65000").End(xlUp).Row + 1
      
      row1 = Sheets(i).UsedRange.Row + x
      Range("A" & x & ":A" & row1) = Sheets(i).Name
      Sheets(i).UsedRange.Copy Cells(x, 2)
     
     End If
Next
Application.ScreenUpdating = True
End Sub

以上代码大部分是借用别人的，自己想加在汇总表的第一列加上各分表的名称，结果效量是以下这种


请教一下各位高手，能说说原因最好了，谢谢

lsc900707

用数组改写，上传附件吧。

想飞的牛

lsc900707 发表于 2018-9-12 21:59
用数组改写，上传附件吧。

好的，谢谢版主提示

想飞的牛

这是以上代码对应的附件，我想要的效果是第一列的数据填满，请各位老师指点一下，谢谢

不知道为什么

想飞的牛 发表于 2018-9-12 23:57
这是以上代码对应的附件，我想要的效果是第一列的数据填满，请各位老师指点一下，谢谢

参考

1. Sub test()
   
2.     For i = 3 To 44
   
3.         If Len(Cells(i + 1, 1)) = 0 Then
   
4.             Cells(i + 1, 1) = Cells(i, 1)
   
5.         End If
   
6.     Next i
   
7. End Sub
   

复制代码

lsc900707

想飞的牛 发表于 2018-9-12 23:57
这是以上代码对应的附件，我想要的效果是第一列的数据填满，请各位老师指点一下，谢谢

1. Sub gj23w98()
   
2.     Dim brr(1 To 10000, 1 To 5)
   
3.     For Each sht In Sheets
   
4.         If sht.Name <> ActiveSheet.Name Then
   
5.             arr = sht.[a1].CurrentRegion
   
6.             For i = 1 To UBound(arr)
   
7.                 m = m + 1
   
8.                 brr(m, 1) = sht.Name
   
9.                 For j = 2 To 5
   
10.                     brr(m, j) = arr(i, j - 1)
    
11.                 Next
    
12.             Next
    
13.         End If
    
14.     Next
    
15.     If m Then Cells.ClearContents: [a2].Resize(m, 5) = brr
    
16. End Sub

复制代码

想飞的牛

lsc900707 发表于 2018-9-13 07:02

谢谢版主，我发现我的row这个没用好，改了一下，不过有点瑕痴，我继续看看，非常感谢你这么早还在关注我这个代码问题，非常感谢！