求段vba代码

mkm-_7605

就是  科室用2 里面的数据是后面31个表格中提取的


方框里面的内容从后面的31个表格里提取的 我只知道一个表格要是一列的数可以写成B1:B31  但是31个表格的b17本别填写到对应的科室用2的b列的b5到b35，咋设置 然后后面到f  ，都是这样重复的，咋处理成一段vba我不知道咋弄简单点，麻烦大佬帮忙写段

yynrzwh

5月.zip (19.42 KB, 下载次数: 16)

2024-5-7 11:05 上传

点击文件名下载附件

mkm-_7605

yynrzwh 发表于 2024-5-7 11:05

谢谢你，

saghj

交个作业。。

mkm-_7605

saghj 发表于 2024-5-7 11:18
交个作业。。

非常感谢

全党

Sub test()
  Dim i&, arr
  Dim w As Worksheet
  arr = Sheets("科室用2").UsedRange.Formula
  For Each w In Sheets
    If w.Name <> "科室用2" Then
       n = n + 1
          arr(n + 4, 1) = n
          arr(n + 4, 2) = w.Cells(17, 2)
          arr(n + 4, 3) = w.Cells(21, 2)
          arr(n + 4, 4) = w.Cells(17, 3)
          arr(n + 4, 5) = w.Cells(21, 3)
          arr(n + 4, 6) = w.Cells(22, 2)
    End If
  Next w
  Sheets("科室用2").UsedRange.Formula = arr
End Sub

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.7
   
2.     Set sh = ThisWorkbook.Sheets("科室用2")
   
3.     b = [{"b17","b21","c17","c21","b22"}]
   
4.     On Error Resume Next
   
5.     For Each sht In Sheets
   
6.         If sht.Name <> sh.Name Then
   
7.             m = m + 1
   
8.             If m = Val(sht.Name) Then
   
9.             For x = 1 To UBound(b)
   
10.                 sh.Cells(m + 4, x + 1) = sht.Range(b(x)).Value
    
11.             Next
    
12.             End If
    
13.         End If
    
14.     Next
    
15.     MsgBox "OK！"
    
16. End Sub
    

复制代码

mkm-_7605

ykcbf1100 发表于 2024-5-7 16:06
参与一下。。。

非常感谢