簿间传输

Qs18

试试..........

Qs18

试试..............

ddz79101

Qs18 发表于 2024-9-5 16:37
试试..............

谢谢老师！运行成功

usedrange

参与一下，逻辑简单，代码有点复杂

usedrange

1. Sub tt()
   
2.     Dim ar, br, cr, i%, j%, pa, wb
   
3.     pa = ThisWorkbook.Path & "\上报.xls"
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     For Each f In Sheets
   
7.         If Len(f.Name) > 2 Then
   
8.             If f.Name = "资产表" Then
   
9.                 Sheets(f.Name).Activate
   
10.                 ar = [a1].CurrentRegion
    
11.                 For i = 3 To UBound(ar)
    
12.                     If ar(i, 2) <> "" And ar(i, 6) <> "" Then
    
13.                         For j = 2 To UBound(ar, 2)
    
14.                             If ar(i, j) = "" Then ar(i, j) = Format("0.00")
    
15.                         Next j
    
16.                     ElseIf ar(i, 2) = "" And ar(i, 6) <> "" Then
    
17.                         For j = 7 To UBound(ar, 2)
    
18.                             If ar(i, j) = "" Then ar(i, j) = "0.00"
    
19.                         Next j
    
20.                     ElseIf ar(i, 6) = "" And ar(i, 2) <> "" Then
    
21.                         For j = 2 To 4
    
22.                             If ar(i, j) = "" Then ar(i, j) = "0.00"
    
23.                         Next j
    
24.                     End If
    
25.                 Next i
    
26.             ElseIf f.Name = "利润表" Then
    
27.                 Sheets(f.Name).Activate
    
28.                 br = [a1].CurrentRegion
    
29.                 For i = 2 To UBound(br)
    
30.                     If br(i, 2) <> "" Then
    
31.                         For j = 3 To UBound(br, 2)
    
32.                             If br(i, j) = "" Then br(i, j) = "0.00"
    
33.                         Next j
    
34.                     End If
    
35.                 Next i
    
36.             ElseIf f.Name = "现金表" Then
    
37.                 Sheets(f.Name).Activate
    
38.                 cr = [a1].CurrentRegion
    
39.                 For i = 2 To UBound(cr)
    
40.                     If cr(i, 2) <> "" Then
    
41.                         For j = 3 To UBound(cr, 2)
    
42.                             If cr(i, j) = "" Then cr(i, j) = "0.00"
    
43.                         Next j
    
44.                     End If
    
45.                 Next i
    
46.             End If
    
47.         End If
    
48.     Next f
    
49. 
    
50.     Set wb = Workbooks.Open(pa)
    
51.         For Each sh In wb.Sheets
    
52.             Sheets(sh.Name).Activate
    
53.             If sh.Name = "资产表" Then
    
54.                 [a1].Resize(UBound(ar), UBound(ar, 2)) = ar
    
55.             ElseIf sh.Name = "利润表" Then
    
56.                 [a1].Resize(UBound(br), UBound(br, 2)) = br
    
57.             ElseIf sh.Name = "现金表" Then
    
58.                 [a1].Resize(UBound(cr), UBound(cr, 2)) = cr
    
59.             End If
    
60.             
    
61.         Next sh
    
62.     wb.Save
    
63.     wb.Close
    
64.     MsgBox "上报成功！", 1
    
65.     Application.ScreenUpdating = True
    
66.     Application.DisplayAlerts = True
    
67. End Sub
    

复制代码

Qs18

ddz79101 发表于 2024-9-5 17:46
谢谢老师！运行成功

ddz79101

usedrange 发表于 2024-9-5 17:54

谢谢老师！运行成功