自動複製有資料的區塊

PJChen

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

PJChen

版大,我找到原因了,這個表已經ok. 謝謝你.
    With Workbooks("Chart-F.xlsx").Sheets("工作表1")
    Set B = Intersect(.UsedRange, .Range("A:D")).SpecialCells(xlCellTypeVisible)
    Workbooks("2011 BCMart Multi-Format.xlsx").Activate
    Sheets("Factory's order").Select
    Range("A1").Select
    B.Copy
    Selection.PasteSpecial xlPasteValues   '選擇性貼上值
    End With

PJChen

版大,
修改後可以執行,但執行不完全,試了好幾次,結果都相同,似乎只有copy 欄A資料,B:C資料COPY不完全,可否幫我看看為什麼?TKS. Chart-F.zip (63.46 KB)

下載次數: 1

2012-1-20 23:38

Hsieh

回復 14# PJChen

With ThisWorkbook.Sheets("Chart-F")
    Set B = Intersect(.UsedRange, .Range("A:D")).SpecialCells(xlCellTypeVisible)
    Workbooks("2011 BCMart Multi-Format.xlsx").Activate
    Sheets("Factory's order").Range("A1").Select
    B.Copy
    Selection.PasteSpecial xlPasteValues   '選擇性貼上值
End With

PJChen

Dear,
我想要複製資料時,完全複製後貼上值,可是執行到選擇性貼上值就失敗了,請問哪裡出錯了? Chart-F.zip (37.44 KB)

下載次數: 2

2012-1-20 21:57

   With ThisWorkbook.Sheets("Chart-F")
    Set B = Intersect(.UsedRange, .Range("A:D")).SpecialCells(xlCellTypeVisible)
    B.Copy Workbooks("2011 BCMart Multi-Format.xlsx").Sheets("Factory's order").Range("A1")  '完全複製
    B.Copy Workbooks("2011 BCMart Multi-Format.xlsx").Sheets("Factory's order").Range("A1").PasteSpecial xlPasteValues  '選擇性貼上值,失敗了

    End With

Hsieh

回復 12# PJChen


    With ThisWorkbook.Sheets("Chart-F")
    Set B = Intersect(.UsedRange, .Range("A:D")).SpecialCells(xlCellTypeVisible)
    B.Copy Workbooks("2011 BCMart Multi-Format.xlsx").Sheets("Factory's order").Range("A1")      '完全複製
   End With

PJChen

我試著修改版主幫我寫的程式,現在有問題的是後半段,copy "Chart-F",A:D有數值的區域,貼到已開啟的檔案"2011 BCMart Multi-Format.xlsx" 的sheets("Factory's order")的A1儲存格,但都貼不上,我將檔案上傳,請大家幫我看看問題在哪裡,謝謝! Chart-F.zip (32.73 KB)

下載次數: 2

2012-1-20 12:34

    With ThisWorkbook.Sheets("Chart-F")
    Set B = Intersect(.UsedRange, .Range("A:D")).SpecialCells(xlCellTypeVisible)
    Windows("2011 BCMart Multi-Format.xlsx").Activate
    Sheets("Factory's order").Select
    B.Copy .Range("A1")  '完全複製
   End With
   
   
End Sub

PJChen

超級版主,謝謝您回覆,前面所回覆執行完全OK.
我將您寫的程式修改到另一個檔案中,以下是將資料另開一個新的工作表(book1)貼上,執行該刪除的資料後,以下是我想新增的程式:
我想將整理後的資料剩下A:D,打開舊檔貼上只有A:D有數值的部份,其路徑及檔名為:P:\BCM\2011 BCMart Multi-Format.xlsx,另一個難題是因為我可能打開的是book2 or book3去執行以下的程式,所以要如何寫才能讓它依bookxx去copy資料?
Sub copy_Chart_F()
'
' copy_Chart_F 巨集
'

'
    Windows("VBA Cluster.xlsm").Activate
    With ThisWorkbook.Sheets("Chart-F")
    .Columns("D:AP").Hidden = False
    Set A = Intersect(.UsedRange, .Range("D:Z")).SpecialCells(xlCellTypeVisible)
    With Workbooks.Add
   With .Sheets(1)
   A.Copy .Range("A1")  '完全複製
     A.Copy
    .Range("A1").PasteSpecial xlPasteValues '選擇性貼上值
    .Columns("G:U").Delete Shift:=xlToLeft
    Columns("B:E").Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
   
   End With
   
   End With
   End With
   
   
End Sub

Hsieh

回復 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. 
   
6.     .Range("A:CZ").AutoFilter Field:=70, Criteria1:=Array( _
   
7.         "Delay", "OK", "pre-Booking"), Operator:=xlFilterValues
   
8.          
   
9.    Set A = Intersect(.UsedRange, .Range("E:BW")).SpecialCells(xlCellTypeVisible)
   
10.    With Workbooks.Add
    
11.    With .Sheets(1)
    
12.    'A.Copy .Range("A1")  '完全複製
    
13.      A.Copy
    
14.     .Range("A1").PasteSpecial xlPasteValues '選擇性貼上值
    
15.    
    
16.     .Columns("BO:BQ").Delete Shift:=xlToLeft
    
17.     .Columns("BD:BM").Delete Shift:=xlToLeft
    
18.     .Columns("AX:AX").Delete Shift:=xlToLeft
    
19.     .Columns("AM:AU").Delete Shift:=xlToLeft
    
20.     .Columns("AA:AA").Delete Shift:=xlToLeft
    
21.     .Columns("V:W").Delete Shift:=xlToLeft
    
22.     .Columns("S:T").Delete Shift:=xlToLeft
    
23.    End With
    
24.    '.SaveAs "D:\另存新檔.xlsx"   '此處儲存檔案
    
25.    End With
    
26.    .ShowAllData '顯示所有資料
    
27.    End With
    
28. End Sub

複製代碼

貼上程式碼要加入行號，如圖操作

下載 (117.96 KB)

2012-1-19 10:58

PJChen

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