On Error Resume Next
Dim oExcel
Dim oExcel1
Dim oExcel2
Dim intReadColumn
Dim blnNull
Dim count
Dim intRow
Dim switch
Const conPath1 = "e:\1.xls" 'path of firstExcelFile1自己改路径
Const conPath2 = "e:\2.xls" 'path of firstExcelFile2自己改路径
Set oExcel = WScript.CreateObject("Excel.Application")
Set oExcel1 = oExcel.Workbooks.Open(conPath1,true)
Set oExcel2 = oExcel.Workbooks.Open(conPath2,false)
oExcel1.Sheets(1).Activate
oExcel2.Sheets(1).Activate
switch = false
intReadColumn = 1
blnNull = False
'这个循环检查了b文件从第一行到200行,
'第一列到第十列的所有单元格,
'确保粘贴是在空行是操作,避免覆盖已有数据。
'可以自定义检查范围,修改i,j的值即可
For i = 1 To 200
If switch Then
Exit For
End If
count = 0
For j = 1 To 10
If oExcel2.Sheets(1).cells(i,j).value = "" Then
count = count + 1
Else
count = 0
End If
If count = 10 Then
blnNull = True
intRow = i 'intRow定义了行前10列为空的行的行数,以确保是后面追加,而不是覆盖已有b的数据
switch = true
Exit For
End if
Next
Next
Do While blnNull
'下面赋值操作即为读入a文件a2:g2的数据,然后循环赋值给b文件那个空行的每一列,其中a的单元格范围可以自定义
oExcel2.Sheets(1).cells(intRow,intReadColumn).value = oExcel1.Sheets(1).cells(2,intReadColumn).value
intReadColumn = intReadColumn + 1
If intReadColumn>7 then
Exit Do
End If
Loop
WScript.Echo "copy successfully!"
oExcel1.Close
Set oExcel1 = Nothing
oExcel2.Save
oExcel2.Close
Set oExcel2 = Nothing
If Err.Number<>0 Then
WScript.Echo Err.Description
End If
内容有点庞大,但管用。小弟不会楼主的区域复制粘贴,所以用了旧办法。另外楼主你要的是数据附加,而非覆盖,但我看你自己的代码操作好像没有检查非空单元格,我这里加入了检查,并有注释。
全手打,求采纳!