把本表格的内容发送到其他文件夹下的表格中

zgm1201

通过老师帮助已测试成功，附件重新上传，发送源在（文件夹\编辑\三环西邬头）文件夹内。

zgm1201

大神快点出手，万分感激。

Si疯子

1. Sub daoru()
   
2.     Dim arr, iRow As Long, wb As Workbook, FilePath As String
   
3.     Application.ScreenUpdating = False
   
4.     iRow = Range("a" & Rows.Count).End(xlUp).Row
   
5.     arr = Range("a6:o" & iRow).Value
   
6.    
   
7.     FilePath = VBA.Replace(ThisWorkbook.Path, "编辑", "数据库")
   
8.     Set wb = Workbooks.Open(FilePath & "10%奖励.xls")
   
9.     wb.Sheets("测试10").Range("a6").Resize(UBound(arr), UBound(arr, 2)).Value = arr
   
10.     wb.Close True
    
11.     Application.ScreenUpdating = True
    
12. End Sub

复制代码

文件夹.rar (20.23 KB, 下载次数: 7)

2019-1-4 09:57 上传

点击文件名下载附件

zgm1201

Si疯子 发表于 2019-1-4 09:58

谢谢！能不能在帮我修改一下，在实际应用中被发送表格是有公式的，现在发送过去后全变成值了。要实现接受表格仍旧是公式。

zjdh

Sub daoru()
    Dim iRow As Long, wb As Workbook, FilePath As String
    Application.ScreenUpdating = False
    Set SH = ThisWorkbook.ActiveSheet
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    FilePath = VBA.Replace(ThisWorkbook.Path, "编辑", "数据库\")
    Workbooks.Open (FilePath & "10%奖励.xls")
    SH.Rows("6:" & iRow).Copy Sheets("测试10").Range("A6")
    ActiveWorkbook.Close True
    Application.ScreenUpdating = True
    MsgBox "数据已发送！"
End Sub

Si疯子

zgm1201 发表于 2019-1-4 10:59
谢谢！能不能在帮我修改一下，在实际应用中被发送表格是有公式的，现在发送过去后全变成值了。要实现接受 ...

1. Sub daoru()
   
2.     Dim arr, iRow As Long, wb As Workbook, FilePath As String
   
3.     Application.ScreenUpdating = False
   
4.     iRow = Range("a" & Rows.Count).End(xlUp).Row
   
5.     FilePath = VBA.Replace(ThisWorkbook.Path, "编辑", "数据库")
   
6.     Set wb = Workbooks.Open(FilePath & "10%奖励.xls")
   
7.     Sheet1.Range("a6:o" & iRow).Copy
   
8.     wb.Sheets("测试10").Range("a6").Select
   
9.     ActiveSheet.Paste
   
10.     wb.Close True
    
11.     Application.ScreenUpdating = True
    
12. End Sub

复制代码

文件夹.rar (24.95 KB, 下载次数: 9)

2019-1-4 12:26 上传

点击文件名下载附件

zgm1201

Si疯子 发表于 2019-1-4 12:26

万分感谢！实际应用已测试成功。

zgm1201

zjdh 发表于 2019-1-4 11:34
Sub daoru()
    Dim iRow As Long, wb As Workbook, FilePath As String
    Application.ScreenUpdatin ...

虽然没采用你的方案，但是万分感谢你的帮助！

Si疯子

zgm1201 发表于 2019-1-4 21:02
虽然没采用你的方案，但是万分感谢你的帮助！

没事，那你用的什么方法呢？

zgm1201

Si疯子 发表于 2019-1-5 17:16
没事，那你用的什么方法呢？

用的是你的方法，那是对zjdh说的。