求助：如何提取总表数据到不同工作表指定单元格

yxzh1985

第一个工作表 sheet3是数据汇总表，

sheet 1, sheet(2)....是需要在黄色单元格提取sheet3相应信息的表，

请问如何实现快速提取填充

randysjf

直接用“=”吧。

qwer401245

删除删除删除

yxzh1985

qwer401245 发表于 2021-4-22 11:02
已实现，请查收

非常感谢，正是想要的结果。
可是我这下载后点击拆分，怎么没反应呢？
请问这是宏还是vba代码，可否请教一下原理，谢谢

qwer401245

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Long, bj As String, rng As Range
   
3.     i = 3
   
4.     bj = Worksheets("数据").Cells(i, "A").Value
   
5.     Do While bj <> ""
   
6.         Worksheets("模板").Copy after:=Worksheets(i - 1)
   
7.         Worksheets(i).Cells(4, "B").Value = Worksheets("数据").Cells(i, "A").Value
   
8.         Worksheets(i).Cells(4, "E").Value = Worksheets("数据").Cells(i, "E").Value
   
9.         Worksheets(i).Cells(6, "B").Value = Worksheets("数据").Cells(i, "G").Value
   
10.         Worksheets(i).Cells(6, "E").Value = Worksheets("数据").Cells(i, "F").Value
    
11.         Select Case Worksheets("数据").Cells(i, "H").Value
    
12.             Case Is = "火车"
    
13.                 Worksheets(i).Cells(8, "C").Value = Worksheets("数据").Cells(i, "A").Value
    
14.                 Worksheets(i).Cells(8, "E").Value = Worksheets("数据").Cells(i, "B").Value
    
15.                 Worksheets(i).Cells(9, "E").Value = Worksheets("数据").Cells(i, "C").Value
    
16.             Case Is = "航空"
    
17.                 Worksheets(i).Cells(10, "C").Value = Worksheets("数据").Cells(i, "A").Value
    
18.                 Worksheets(i).Cells(10, "E").Value = Worksheets("数据").Cells(i, "B").Value
    
19.                 Worksheets(i).Cells(11, "E").Value = Worksheets("数据").Cells(i, "C").Value
    
20.             Case Is = "自驾"
    
21.                 Worksheets(i).Cells(12, "C").Value = Worksheets("数据").Cells(i, "B").Value
    
22.                 Worksheets(i).Cells(12, "E").Value = Worksheets("数据").Cells(i, "C").Value
    
23.             Case Is = "客车"
    
24.                 Worksheets(i).Cells(14, "C").Value = Worksheets("数据").Cells(i, "A").Value
    
25.                 Worksheets(i).Cells(14, "E").Value = Worksheets("数据").Cells(i, "B").Value
    
26.                 Worksheets(i).Cells(15, "E").Value = Worksheets("数据").Cells(i, "C").Value
    
27.    End Select
    
28.         i = i + 1
    
29.         bj = Worksheets("数据").Cells(i, "C").Value
    
30.     Loop
    
31. End Sub
    

复制代码

qwer401245

删除删除删除

qwer401245

删除删除删除

qwer401245

删除删除删除

qwer401245

yxzh1985 发表于 2021-4-22 14:06
非常感谢，正是想要的结果。
可是我这下载后点击拆分，怎么没反应呢？
请问这是宏还是vba代码，可否请 ...

删除删除删除

qwer401245

1. 删除删除删除删除

复制代码