同个文件夹在A表输入数据保存到B工作表里

起舞飞歌

求助各位大神出手相助：

                                同一个文件夹两个独立工作表，在采购申请单工作表输入数据，点击提交后保存到申请单明细表相对应单元格里并提交后自动更新申请编码.拜托！拜托各位大神只有主要代码写一下保存指定单元格只要举例几个就好，后续自己更改。不胜感激！

shiruiqiang

东西很简单，就是遍历一下，后台打开另一工作簿。
建议你把对应的单元格标注好。

ykcbf1100

应该不难，就是个体力活。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2023.12.30
   
2.     Dim arr, brr, wb
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     p = ThisWorkbook.Path
   
6.     f = p & "\申请单明细.xlsx"
   
7.     Set sh = ThisWorkbook.Sheets("申请单")
   
8.     Set wb = Workbooks.Open(f, 0)
   
9.     With wb.Sheets("申请明细")
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         num = Val(Mid(.Cells(r, 2), 3))
    
12.     End With
    
13.     ReDim brr(1 To 1000, 1 To 26)
    
14.     On Error Resume Next
    
15.     With sh
    
16.         r = .UsedRange.Find("合计").Row
    
17.         arr = .UsedRange
    
18.         For i = 7 To r - 1
    
19.             If arr(i, 1) <> Empty Then
    
20.                 m = m + 1
    
21.                 brr(m, 1) = arr(2, 16)
    
22.                 brr(m, 2) = "xs" & Format(num + m, "00000")
    
23.                 brr(m, 3) = arr(3, 2)
    
24.                 brr(m, 4) = arr(r + 2, 2)
    
25.                 brr(m, 5) = arr(4, 2)
    
26.                 brr(m, 6) = arr(4, 11)
    
27.                
    
28.                 For j = 2 To 9
    
29.                     brr(m, j + 5) = arr(i, j)
    
30.                 Next
    
31.                 brr(m, 15) = arr(i, 1)
    
32.                 For j = 10 To 16
    
33.                     brr(m, j + 6) = arr(i, j)
    
34.                 Next
    
35.             End If
    
36.         Next
    
37.     End With
    
38.     With wb.Sheets("申请明细")
    
39.         r = .Cells(Rows.Count, 1).End(3).Row
    
40.         With .Cells(r + 1, 1).Resize(m, 23)
    
41.             .Value = brr
    
42.             .Borders.LineStyle = 1
    
43.             .HorizontalAlignment = xlCenter
    
44.             .VerticalAlignment = xlCenter
    
45.         End With
    
46.     End With
    
47.     wb.Close 1
    
48.     Application.ScreenUpdating = True
    
49.     MsgBox "OK！"
    
50. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

起舞飞歌

shiruiqiang 发表于 2023-12-29 21:49
东西很简单，就是遍历一下，后台打开另一工作簿。
建议你把对应的单元格标注好。

您好老师，感谢百忙之中还关注我求助，对应单元格标注好的了，只有主要代码写一下指定单元格只要举例几个就好，后续自己更改。不胜感激！

起舞飞歌

ykcbf1100 发表于 2023-12-30 09:43
附件供参考。。。

感谢老师出手相助，可怎么没办法下载呀

ykcbf1100

起舞飞歌 发表于 2023-12-30 13:26
感谢老师出手相助，可怎么没办法下载呀

附件已更新，我这里能正常下载和打开。

起舞飞歌

ykcbf1100 发表于 2023-12-30 09:43
附件供参考。。。

感谢老师出手相助，奈何分数不足