返回列表 上一主題 發帖

自動複製有資料的區塊

自動複製有資料的區塊

Hi,
我在錄製巨集時,常會用到複製一個指定區塊到另一個新的sheet中,例如B2:E55,但因為資料會一直增加,可能下回是B2:F99,但在錄巨集時我又不想將範圍拉得太大,能不能在執行巨集時,若我要B2:E..(資料最底端),也有可能是C3:Y180,因為我有很多sheet要執行,但每個工作表不同,所以範圍也都不一樣,但唯一相同的,都是要至資料的最底端,它可以自動篩選出有資料的區塊嗎?

ActiveSheet.UsedRange.Copy Sheet3.[A65536].End(3)(2, 1)

TOP

大大好,
我將你回復的寫法套到我的巨集中,但無法執行,檢查不出哪裡不對,我copy出來,可否幫忙看一下?
    Windows("VBA Cluster.xlsm").Activate
    Sheets("BCM控管").Select
    Columns("A:CZ").Select
    Selection.EntireColumn.Hidden = False
    ActiveSheet.Range("$A$1CZ$1800").AutoFilter Field:=70, Criteria1:=Array( _
        "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues         
    Range("E1:BW1800").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("BO:BQ").Select
    Selection.Delete Shift:=xlToLeft
    Columns("BD:BM").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AX:AX").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AM:AU").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AA:AA").Select
    Selection.Delete Shift:=xlToLeft
    Columns("V:W").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:T").Select
    Selection.Delete Shift:=xlToLeft   
ActiveSheet.UsedRange.Copy SheetsBCM控管.[A65536].End(3)(2, 1).Select  =>這裡無法執行

    'Range("A1:AQ350").Select
    Selection.Copy
   
    Workbooks.Add
    ActiveSheet.Paste

TOP

大師,可否幫忙看看哪裡出了問題? 我的工作表每天都會增加新的資料,我在copy工作表資料時會做些篩選再進行copy..
    Windows("VBA Cluster.xlsm").Activate
    Sheets("BCM控管").Select
    Columns("A:CZ").Select
    Selection.EntireColumn.Hidden = False
    ActiveSheet.Range("$A$1CZ$1800").AutoFilter Field:=70, Criteria1:=Array( _
        "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues          '這是有進行篩選後的
    Range("E1:BW1800").Select    '這裡的資料隨時會增加,有可能是E1:BW2000,或者別的工作表也會COPY不同的資料,有可能是B2:G500,因為很多工作表用得到這個功能,我希望在進行篩選後,只COPY有資料的地方,而不要大範圍的COPY,會造成太多垃圾,前面oobird教我用"
ActiveSheet.UsedRange.Copy Sheet3.[A65536].End(3)(2, 1)",但都無法執行,請高手幫忙找找原因出在哪?

    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
   
ActiveSheet.UsedRange.Copy SheetsBCM控管.[A65536].End(3)(2, 1).Select  '我套用後,這裡無法執行
      
    Workbooks.Add
    ActiveSheet.Paste

TOP

我需要善心人士來幫忙,哪位大師可以幫我看看上面的程式出了什麼問題?救命!

TOP

[attach]excel[/attach]前面的說明+上傳檔案,或許能比較明白我在說什麼?請大家幫個忙!謝謝

VBA Cluster.zip (83.23 KB)

excel

TOP

  1. Sub Ex()
  2.     With ThisWorkbook.Sheets("BCM控管")
  3.     .Columns("A:CZ").Hidden = False

  4.     .Range("A:CZ").AutoFilter Field:=70, Criteria1:=Array( _
  5.         "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues
  6.          
  7.    Set a = Intersect(.UsedRange, .Range("E:BW")).SpecialCells(xlCellTypeVisible)
  8.    With Workbooks.Add
  9.    With .Sheets(1)
  10.     a.Copy .[A1]
  11.     .Columns("BO:BQ").Delete Shift:=xlToLeft
  12.     Columns("BD:BM").Delete Shift:=xlToLeft
  13.     Columns("AX:AX").Delete Shift:=xlToLeft
  14.     Columns("AM:AU").Delete Shift:=xlToLeft
  15.     Columns("AA:AA").Delete Shift:=xlToLeft
  16.     Columns("V:W").Delete Shift:=xlToLeft
  17.     Columns("S:T").Delete Shift:=xlToLeft
  18.    End With
  19.    '.SaveAs "D:\另存新檔.xlsx"   '此處儲存檔案
  20.    End With
  21.    End With
  22. End Sub
複製代碼
回復 6# PJChen
學海無涯_不恥下問

TOP

謝謝超級版主,可以運作了!受教了.:)
我想問幾個問題: a) 版主貼出來的程式為什麼左邊都有行號,怎麼做的?   b)用錄製的巨集其程式語言為什麼跟你寫出來的不一樣?你寫出來的程式也可以在excel VBA中使用,但這是什麼程式語言?哪種程式語言可以共用在excel中?       c) 我完全不會寫程式,如果我想自學,什麼語言是入門,有沒有推薦的書?   d)   .Range("A:CZ").AutoFilter Field:=70, Criteria1:=Array( _
        "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues 是有條件的篩選資料,但我要讓篩選自動取消要怎麼寫?
   e)最後一個問題,如前面你所寫的程式11行     a.Copy .[A1],是將後面的程式叫做[A1],若同一個巨集中我想用同樣的手法copy不同的資料,則是否要將[A1]改為[A2]或其它代碼?

TOP

大大,不好意思再補個問題:
    以前面的程式 a.Copy .[A1],是copy資料(含格式,公式),我想問其他的寫法如下:
a) copy資料(含格式)之後貼上值=讓原先的資料沒有公式
b) copy資料只貼上值(不含格式)
請賜教這二種寫法.

TOP

回復 9# PJChen
我的寫法也是VBA語言
VBA是VB的高階語言,語法相同,只是VBA已經有了許多物件與模組供使用
自學VBA當然不是問題,只是錄製所得的程式碼會將所有動作都記錄進去,造成許多不必要的程式碼
你應配合F1說明來了解每個指令,與程式敘述的意義,再多看別人的寫法,加以思考其邏輯
程式碼中a.Copy .[A1]
這是將物件變數a複製到新活頁簿的第一個工作表的A1儲存格的意思
至於新檔案只要寫入值及顯示全部資料請參考以下程式碼
  1. Sub Ex()
  2. Dim A As Range
  3.     With ThisWorkbook.Sheets("BCM控管")
  4.     .Columns("A:CZ").Hidden = False

  5.     .Range("A:CZ").AutoFilter Field:=70, Criteria1:=Array( _
  6.         "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues
  7.          
  8.    Set A = Intersect(.UsedRange, .Range("E:BW")).SpecialCells(xlCellTypeVisible)
  9.    With Workbooks.Add
  10.    With .Sheets(1)
  11.    'A.Copy .Range("A1")  '完全複製
  12.      A.Copy
  13.     .Range("A1").PasteSpecial xlPasteValues '選擇性貼上值
  14.    
  15.     .Columns("BO:BQ").Delete Shift:=xlToLeft
  16.     .Columns("BD:BM").Delete Shift:=xlToLeft
  17.     .Columns("AX:AX").Delete Shift:=xlToLeft
  18.     .Columns("AM:AU").Delete Shift:=xlToLeft
  19.     .Columns("AA:AA").Delete Shift:=xlToLeft
  20.     .Columns("V:W").Delete Shift:=xlToLeft
  21.     .Columns("S:T").Delete Shift:=xlToLeft
  22.    End With
  23.    '.SaveAs "D:\另存新檔.xlsx"   '此處儲存檔案
  24.    End With
  25.    .ShowAllData '顯示所有資料
  26.    End With
  27. End Sub
複製代碼
貼上程式碼要加入行號,如圖操作
未命名.PNG
2012-1-19 10:58
學海無涯_不恥下問

TOP

        靜思自在 : 人事的艱難與琢磨,就是一種考驗。
返回列表 上一主題