最佳解答
以下程式預定從 C2 複製到 C6
Option Explicit Const kRowCount = 300 Sub Main() Dim nI For nI = 2 To 6 OneCopy (nI) Next nI End Sub Sub OneCopy(ByVal pIdx As Integer) Dim nRowBegin, nRowEnd nRowBegin = 2 + (pIdx - 2) * kRowCount nRowEnd = nRowBegin + kRowCount - 1 Sheets("SheetB").Select Range("C" & pIdx).Select Selection.Copy Sheets("SheetA").Select Range("B" & nRowBegin).Select ActiveSheet.Paste Range("B" & nRowBegin & ":B" & nRowEnd).Select Selection.FillDown End Sub另外，點這裡是我這次鐵人賽唯一的一篇文章，喜歡的話左上角點 Like
回應 1
- 檢舉
跳到主要內容
已不再支援此瀏覽器。
請升級至 Microsoft Edge，以利用最新功能、安全性更新和技術支援。
(Excel 的工作表複製方法)
- 發行項
- 04/11/2022
本文內容
將工作表複製到目前活頁簿或新活頁簿中的另一個位置。
語法
運算式。_在)_之後複製 (
表達 代表 工作表 物件的變數。
參數
| Before | 選用 | Variant | 要複製的工作表將放在此工作表之前。 如果您指定 After，便無法指定 Before 。 |
| After | 選用 | Variant | 要複製的工作表將放在此工作表之後。 如果已經指定了 Before，則無法指定 After。 |
註解
如果您未指定 Before 或 After，Microsoft Excel 會建立包含複製之 工作表 物件的新活頁簿。 新建立的活頁簿會容納 Application.ActiveWorkbook 屬性並包含單一工作表。 單一工作表會保留來源工作表的 Name 和 CodeName 屬性。 如果複製的工作表持有 VBA 專案中的工作表程式碼工作表，則該工作表也會進入新的活頁簿。
您可以將多個工作表的陣列選取專案複製到新的空白活頁 簿 物件，方式應類似。
來源和目的地必須位於相同的 Excel。應用程式實例，否則會引發執行時間錯誤 ' 1004 '：不支援此類介面（ Sheet1.Copy objWb.Sheets(1) 如已使用），或執行時間錯誤 ' 1004 '：複製工作表類別的方法失敗（如果使用類似 ThisWorkbook.Worksheets("Sheet1").Copy objWb.Sheets(1) ）。
範例
此範例會複製 Sheet1，並將複製的工作表放在 Sheet3 之後。
Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")本範例會先將 Sheet1 複製到新的空白活頁簿，然後儲存並關閉新的活頁簿。
這個範例會將工作表 Sheet1、Sheet2 及 Sheet4 複製到新的空白活頁簿，然後儲存並關閉新的活頁簿。
Worksheets(Array("Sheet1", "Sheet2", "Sheet4")).Copy With ActiveWorkbook .SaveAs Filename:=Environ("TEMP") & "\New3.xlsx", FileFormat:=xlOpenXMLWorkbook .Close SaveChanges:=False End With支援和意見反應
有關於 Office VBA 或這份文件的問題或意見反應嗎？ 如需取得支援服務並提供意見反應的相關指導，請參閱 Office VBA 支援與意見反應。
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
从一个工作簿各个子表中复制数据粘贴到另一个工作簿指定位置中，并对指定列进行排序，这个是我们在日常工作中经常做的，如何减少繁琐的工作步骤，提高效率，一键完成上面的工作。下面介绍通过VBA，如何自动化跨工作簿复制粘贴及排序。
图一
图二
需要将图一工作簿中三个子表含有公式的数据，复制粘贴数值到图二的表1，并对指定列进行降序排序，可以直接点击图二中执行的控件即可完成；以下是VBA脚本的实现。 Sub scopy2() ' ' 复制粘贴及排序 ' '复制粘贴 Application.ScreenUpdating = False '禁止屏幕更新数据 Windows("xxx.xlsx").Activate '图一的表名 Sheets("表一").Select Range("B5:X19").Select Selection.Copy '复制 Windows("aaaa.xlsm").Activate '图二的表名 Sheets("1").Select Range("A6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '粘贴成数值 Windows("xxx.xlsx").Activate '图一的表名 Sheets("表二").Select ' Range("B5:T19").Select Application.CutCopyMode = False Selection.Copy Windows("aaaa.xlsm").Activate '图二的表名 Sheets("1").Select Range("Y6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("xxx.xlsx").Activate Sheets("表三").Select Range("B6:R20").Select Application.CutCopyMode = False Selection.Copy Windows("aaaa.xlsm").Activate Sheets("1").Select Range("AS6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '筛选排序 Windows("aaaa.xlsm").Activate Sheets("1").Select Range("A6:w20").Select Selection.AutoFilter '筛选 ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "b6:b20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal '筛选并对指定列进行排序 With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("I10").Select Selection.AutoFilter Range("y6:Aq20").Select Selection.AutoFilter ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "Ab6:Ab20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("AB9").Select Selection.AutoFilter Range("As6:Bi20").Select Selection.AutoFilter ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "At6:At20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("AS12").Select Selection.AutoFilter '去掉筛选 Application.ScreenUpdating = True '解除禁止屏幕更新数据 End Sub
在图二的子表1的表名点右键，点击查看代码，插入模块1，粘贴上面的代码，保存。
回到表格，在开发工具里-插入-表单控件
选中控件点右键可以选择指定的宏名称，同时修改控件名称。
关注以下公众号可以更方便查看文章哦(*￣︶￣)