彰化一整天的論壇

 找回密碼
 立即註冊
查看: 808|回復: 0

將所有工作表複製到目前工作表

[複製鏈接]
發表於 2014-3-27 09:59:08 | 顯示全部樓層 |閱讀模式
本帖最後由 imingho 於 2014-3-27 10:10 編輯
  1. Sub CopySheet()
  2.     Application.ScreenUpdating = False
  3.     For j = 1 To Sheets.Count
  4.        If Sheets(j).Name <> ActiveSheet.Name Then
  5.        X = Range("A" & Excel.Rows.Count).End(xlUp).Row + 1
  6.        Sheets(j).UsedRange.Copy Cells(X, 1)
  7.    End If
  8.    Next
  9.    Range("B1").Select
  10.    Application.ScreenUpdating = True
  11.    MsgBox "Finsh", vbInformation, "提示"
  12. End Sub
複製代碼

不複製第一列的程式碼
  1. Private Sub CopySheetNoTitle()
  2.     Application.ScreenUpdating = False
  3.     For j = 1 To Sheets.Count
  4.        If Sheets(j).Name <> ActiveSheet.Name Then
  5.            X = Range("A" & Excel.Rows.Count).End(xlUp).Row + 1
  6.            Sheets(j).UsedRange.Offset(1, 0).Resize(Sheets(j).UsedRange.Rows.Count - 1, Sheets(j).UsedRange.Columns.Count).Copy Cells(X, 1)
  7.        End If
  8.     Next
  9.     Range("B1").Select
  10.     Application.ScreenUpdating = True
  11.     MsgBox "Finsh", vbInformation, "提示"
  12. End Sub
複製代碼

回復

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  

GMT+8, 2020-2-24 04:33 , Processed in 0.139760 second(s), 19 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表