[已解决]请老师们修改一下代码

米特峰

请教666.zip (23.36 KB, 下载次数: 3)

2014-11-27 14:47 上传

点击文件名下载附件

问题：把工作薄"问题.XLM"中B3：G3的内容粘贴到《测试文件夹》中"测试文件.xlsm"的"表2"的B列从最后一行也就是 B1048576单元格开始往上第一个有数据的单元格，然后+1就是B列最下面的非空单元格的下一个单元格的位置。

正确的结果应该是：
在"测试文件.xlsm"的"表2"的B:G列空白情况下，
执行第一次宏，工作薄"问题.XLM"中B3：G3的内容应该粘贴到"测试文件.xlsm"的"表2"的B2，
执行第二次宏，工作薄"问题.XLM"中B3：G3的内容应该粘贴到"测试文件.xlsm"的"表2"的B3，
执行第三次宏，工作薄"问题.XLM"中B3：G3的内容应该粘贴到"测试文件.xlsm"的"表2"的B4，
如此重复。。。。。

而我出现的问题是，无论执行多少次宏，工作薄"问题.XLM"中B3：G3的内容始终粘贴在"测试文件.xlsm"的"表2"的B12:G12，请老师们帮忙修改一下，并且指正讲解一下。

1. Sub 测试()
   
2. Dim wb As Workbook
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Set wb = GetObject(ThisWorkbook.Path & "\测试文件夹\测试文件.xlsm")
   
6. [B3：G3].Copy wb.Sheets("表2").Range("B" & Range("B1048576").End(xlUp).Row + 1)
   
7. Application.Windows(wb.Name).Visible = True
   
8. wb.Close 1
   
9. Application.DisplayAlerts = True
   
10. Application.ScreenUpdating = True
    
11. End Sub

复制代码

最佳答案

月排行榜 / 总排行榜

那么的帅

2014-11-27 15:34

1. Sub 测试()
   
2.     Dim wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set wb = GetObject(ThisWorkbook.Path & "\测试文件夹\测试文件.xlsm")
   
6.     [B3:G3].Copy wb.Sheets("表2").Range("B" & wb.Sheets("表2").Range("B1048576").End(xlUp).Row + 1) '复制到的单元格前要指定工作表，否则默认为当前工作表
   
7.     Application.Windows(wb.Name).Visible = True
   
8.     wb.Close 1
   
9.     '其余类似
   
10.     Application.DisplayAlerts = True
    
11.     Application.ScreenUpdating = True
    
12. End Sub

复制代码

跳转到最佳答案楼层

那么的帅

1. Sub 测试()
   
2.     Dim wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set wb = GetObject(ThisWorkbook.Path & "\测试文件夹\测试文件.xlsm")
   
6.     [B3:G3].Copy wb.Sheets("表2").Range("B" & wb.Sheets("表2").Range("B1048576").End(xlUp).Row + 1) '复制到的单元格前要指定工作表，否则默认为当前工作表
   
7.     Application.Windows(wb.Name).Visible = True
   
8.     wb.Close 1
   
9.     '其余类似
   
10.     Application.DisplayAlerts = True
    
11.     Application.ScreenUpdating = True
    
12. End Sub

复制代码