叩谢，麻烦大神帮我修改

xiaoa625

标黄的数据，填写付款申请表自动汇不到汇总表。叩谢，麻烦大神帮我修改代码

Qs18

1. Sub 保存()
   
2. On Error Resume Next
   
3. Application.ScreenUpdating = False
   
4. If MsgBox("是否保存", vbYesNo, "温馨请问") = vbNo Then Exit Sub '如果点否就退出
   
5. Dim mybook As Workbook
   
6. Dim i As Integer
   
7. Dim r, m, j, a
   
8.   Sheets("付款申请单").Activate
   
9.   a = [{"E3","D2","B3","B5","B6","B7","B8","B9"}]
   
10.   With Sheets("汇总")
    
11.      r = .Range("A1").CurrentRegion.Rows.Count + 1
    
12.      For i = 1 To UBound(a)
    
13.         a(i) = Range(a(i))
    
14.      Next
    
15.      .Range("a" & r).Resize(1, UBound(a)) = a
    
16. 
    
17. End With
    
18. Application.ScreenUpdating = True
    
19. MsgBox "添加成功！"
    
20. End Sub

复制代码

Qs18

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

Qs18

试试.........

wengjl

Option Explicit
Sub 保存()
On Error Resume Next
Application.ScreenUpdating = False
If MsgBox("是否保存", vbYesNo, "温馨请问") = vbNo Then Exit Sub '如果点否就退出
Dim mybook As Workbook
Dim i As Integer
Dim r, m, j
  Sheets("付款申请单").Activate
  With Sheets("汇总")
     r = .Range("A65536").End(xlUp).Row + 1
     m = [B5].End(4).Row - 5
     .Cells(r, 8).Resize(m, 1) = [B9] '收料数据的第2列向下移动一个的交叉地方的单元格等于收料单的I2单元格   付款金额
     .Cells(r, 7).Resize(m, 1) = [B8] '收料数据的第1列向下移动一个的交叉地方的单元格等于收料单的C2单元格  付款银行
     .Cells(r, 6).Resize(m, 1) = [B7] '收料数据的第三列向下移动一个的交叉地方的单元格等于收料单的E3单元格  备注
     .Cells(r, 5).Resize(m, 1) = [B6] '收料数据的第2列向下移动一个的交叉地方的单元格等于收料单的I2单元格   用途
     .Cells(r, 4).Resize(m, 1) = [B5] '收料数据的第1列向下移动一个的交叉地方的单元格等于收料单的C2单元格  付款类型
     .Cells(r, 3).Resize(m, 1) = [B3] '收料数据的第三列向下移动一个的交叉地方的单元格等于收料单的E3单元格  收款名称
     .Cells(r, 2).Resize(m, 1) = [D2] '收料数据的第2列向下移动一个的交叉地方的单元格等于收料单的I2单元格   申请日期
     .Cells(r, 1).Resize(m, 1) = [E3] '收料数据的第1列向下移动一个的交叉地方的单元格等于收料单的C2单元格  合同编号
End With
Application.ScreenUpdating = True
End Sub
Sub 新单据号码()
If MsgBox("是否新增", vbYesNo, "温馨请问") = vbNo Then Exit Sub '如果点否就退出
With Sheet1
If Left(.[G2], 8) = Application.Text(Date, "yyyymmdd") Then
Else
End If
End With
    Range("B5:B9").Select
    Range("B6").Activate
    Selection.ClearContents
    Range("B6").Select
End Sub

将红色的 m = [B5].End(4).Row - 5 改为 m=1 试试

xiaoa625

叩谢。大神，真是帅

sxbjzjf110

把你的代码修改了一下。