-- 作者：有点甜
-- 发布时间：2018/5/29 11:43:00
--
比较麻烦，参考代码，细节自己调整
Dim fl As String = "d:\\test.xls"
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("sheet3") \'指定要复制的工作表
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("sheet1")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("sheet2")
Dim x As Integer = Ws1.UsedRange.Rows.Count+1
Ws2.UsedRange.Copy
ws1.Select
ws1.Cells(x,2).Select \'纵向拷贝
ws1.paste
\'设置列格式
ws2.Select
ws2.rows("1:" & ws2.UsedRange.rows.count).Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.rows(x & ":" & x+ws2.usedRange.rows.count).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False
\'设置行格式
ws2.Select
ws2.columns(ws2.cells(1,1).address.split("$")(1) & ":" & ws2.cells(1,ws2.UsedRange.columns.count).address.split("$")(1)).Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.columns(ws1.cells(1,2).address.split("$")(1) & ":" & ws1.cells(1,2+ws2.usedRange.columns.count).address.split("$")(1)).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False
\'设置单元格格式
ws2.Select
ws2.UsedRange.Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.range(ws1.cells(x, 2).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, 2+ws2.UsedRange.columns.count).address).Select
msgbox(ws1.cells(x, 2).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, 2+ws2.UsedRange.columns.count).address)
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False
\'Wb.Save
app.Visible = True
\'App.Quit
|