如题,代码注释很详细,稍作修改就可以用,运行前需要打开你的两个工作簿。
详细解释版本:
有两个工作簿,每个工作簿都有几百张表,表的数量是一样的,
我需要从一个工作簿中将指定位置的数据粘贴到另一个工作簿的指定位置,
要保持格式不变
我首先尝试了Python,但是失败了,我搞定的地方在于:
(1)保存问题,一次只能保存一张表而不是一个工作簿。
(2)格式问题,我需要读出原表格式然后写入新表。
注意:当数据量过大时,请不要关闭屏幕刷新,excel可能会出现”警告:剪贴板错误“,该错误会导致数据中的某几项粘贴出错。
Sub 宏1()
'
' 宏1 宏
'
'
Dim wb1 As Workbook '定义一个工作簿变量
Dim wb2 As Workbook '定义一个工作部变量
Dim ws As Worksheet '定义一个工作表变量
Dim i As Integer '定义一个整数型变量
Set wb1 = Workbooks("原始.xlsx") '设置变量值
Set wb2 = Workbooks("粘贴.xlsx")
For i = 1 To wb1.Worksheets.Count
'遍历我的所有工作表,wb1.Worksheets.Count用于获取原始工作表的数量
'打开原始工作簿
Windows("原始.xlsx").Activate
'选择第I个工作表
Sheets(wb1.Worksheets.Item(i).Name).Select
'选择需要复制的单元格
Range("B2:C2").Select
'复制它们
Selection.Copy
'打开粘贴工作簿
Windows("粘贴.xlsx").Activate
'选择第I个工作表
Sheets(wb1.Worksheets.Item(i).Name).Select
'选择需要粘贴的单元格
Range("B2:C2").Select
'粘贴
ActiveSheet.Paste
'以下为重复上述步骤,因为我有不同的需要粘贴的数据
Windows("原始.xlsx").Activate
Sheets(wb1.Worksheets.Item(i).Name).Select
Range("B4:C4").Select
Selection.Copy
Windows("粘贴.xlsx").Activate
Sheets(wb1.Worksheets.Item(i).Name).Select
Range("B4:C4").Select
ActiveSheet.Paste
Windows("原始.xlsx").Activate
Sheets(wb1.Worksheets.Item(i).Name).Select
Range("E4:F4").Select
Selection.Copy
Windows("粘贴.xlsx").Activate
Sheets(wb1.Worksheets.Item(i).Name).Select
Range("E4:F4").Select
ActiveSheet.Paste
Next '下一个,相当于i+1
End Sub