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
谢谢我看了一下
主要是app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)这句话吗
我之前的代码是
Dim Rg As MSExcel.Range = Ws.UsedRange
'MessageBox.Show("导入粘贴开始行位置:" & startRow & "|一共行数" & Rg.Rows.count )
'MessageBox.Show("打开记录文件:" & fl )
Rg.Copy
rg_pdf.PasteSpecial() '默认粘贴全部
为啥不行呢
加好友 
发短信
Post By：2019/3/2 12:00:00 [只看该作者]
