先說明下：原表格是分上下兩塊，原表格上部分中標題欄占8行，填寫部分15行，中間空一行，下部分表頭占3行，填寫部分占15行，現想只保留上半部分，不要下半部分，但生成后第一頁生成正常，結果第二頁生成表格時有斷的。麻煩高手如何能生成連續的資料？程式中的程式有的可能是沒有用，不專業，麻煩高手解決下，我是菜鳥，告訴我下怎么修改，詳細些，萬分感激！
Sub 統計材料()
Dim k As Integer
k = Sheets("操作表格").Range("c1").Value
Sheets("上").Select
Range(Cells(7, 2), Cells(7, 60)).Select
Selection.Copy
Range(Cells(8, 2), Cells(k + 7, 60)).Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
'轉換為文字
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("下").Select
Range(Cells(7, 2), Cells(7, 60)).Select
Selection.Copy
Range(Cells(8, 2), Cells(k + 7, 60)).Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
'轉換為文字
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("操作表格").Select
End Sub
Sub 恢復初始()
'上下表格恢復初始
Dim k As Integer
k = Sheets("操作表格").Range("c1").Value
Sheets("上").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("下").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("操作表格").Select
Dim i As Integer
i = Sheets("操作表格").Range("c2").Value
Sheets("管段材料表").Select
Range(Rows(42), Rows(i)).Select
' Selection.Delete Shift:=xlUp
Selection.ClearContents
ActiveSheet.DrawingObjects.Delete
ActiveSheet.PageSetup.PrintArea = "$B$1:$BD$41"
Sheets("操作表格").Select
End Sub
Sub 上下恢復初始()
'上下表格恢復初始
Dim k As Integer
k = Sheets("操作表格").Range("c1").Value
Sheets("上").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("下").Select
Range(Cells(8, 2), Cells(k + 7, 60)).Select
Selection.ClearContents
Sheets("操作表格").Select
Sheets("操作表格").Select
End Sub
Sub 復制管段材料表模板()
Dim i As Integer
Dim k As Integer
k = Sheets("操作表格").Range("c2").Value
For i = 1 To k Step 41
Sheets("模板").Select
Rows("1:41").Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i, 1), Cells(i + 40, 60)).Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
Next
Sheets("操作表格").Select
End Sub
Sub 生成管段材料表()
'第1頁
Sheets("上").Select
Rows("8:22").Select
Selection.Copy
Sheets("管段材料表").Select
Rows("8:22").Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
Sheets("下").Select
Rows("8:22").Select
Selection.Copy
Sheets("管段材料表").Select
Rows("26:40").Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
'第2頁
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = 1
k = Sheets("操作表格").Range("c4").Value
For i = 23 To k Step 15
Sheets("上").Select
Range(Cells(i, 1), Cells(i + 14, 60)).Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i + 26 * j, 1), Cells(i + 26 * j + 14, 60)).Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
Sheets("下").Select
Range(Cells(i, 1), Cells(i + 14, 60)).Select
Selection.Copy
Sheets("管段材料表").Select
Range(Cells(i + 18 + 26 * j, 1), Cells(i + 32 + 26 * j, 60)).Select
ActiveSheet.Paste
'清除剪貼板
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
j = j + 1
Next
Sheets("管段材料表").Select
ActiveSheet.PageSetup.PrintArea = "$B:$BD"
Sheets("操作表格").Select
End Sub
uj5u.com熱心網友回復：
沒太看懂樓主的問題。可以自己嘗試加點斷點，一步一步執行看看問題原因轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/36929.html
標籤：VBA
上一篇：VB計算任意兩個整數之和與積