請問如何設定VBA自動判斷 [複製工作表某區間的資料]

luckysan

請見檔案壓縮檔案"VBA練習" 解壓縮後,當中有一個是"範例"活頁簿,另一個是"空白帳冊"活頁簿,兩個須同時開啟才能使用下方的VBA,
如果有大大可以幫忙設成只開啟範例, 就自動複製貼上資料到"空白帳冊"並同時刪除所複製的來源資料,那就更加感謝了!!

目前我只能夠使用下方判斷每個工作表在銷貨日期那一欄若沒有值(日期)則複製有資料的部分到"空白帳冊"活頁簿對應的客戶工作表裡面

Sub Copyandpastethendelete()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  Set wsCopy = Workbooks("範例.xlsm").Worksheets("泰C071")
  Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("泰C071")
   
    '1. Find last used row in the copy range based on data in column D
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
      
    '2. Find first blank row in the destination range based on data in column B
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
   
    '3. Copy & Paste Data
    wsCopy.Range("B17:X51" & lCopyLastRow).Copy _
      wsDest.Range("B7")
   
    '4. Clear contents of existing data range
    wsCopy.Range("B17:X51" & lDestLastRow).ClearContents

   
End Sub

藍色部分要自己KEY每個工作表的名稱, 紅色部分也是自己要看範圍區間去打,
請問有什麼辦法可以設定除了"範例"檔案裡面的第一個&第二個工作表以外,
其他無論多少個工作表都去判斷, 以及查對若B欄沒有值,就選取整個範圍複製貼上到空白帳冊活頁簿對應客戶的工作表裡面,
並刪除原始在"範例"活頁簿工作表當中的複製來源資料

附件有圖片是我執行上方程式後的截圖畫面,
但我不想每次只能自己手動設定每個工作表與區間範圍. 還請大家多多幫忙~
謝謝!!

yws0915

http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類似，8樓的帖子可以參考

luckysan

yws0915 發表於 2020-12-25 09:59
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類 ...

不好意思進去後是什麼掌上論壇手機畫面欸...連結好像有錯喔!

imingho

yws0915 發表於 2020-12-25 09:59
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類 ...

請參考.
http://discuz.bestdaylong.com/fo ... hread&tid=39059

luckysan

imingho 發表於 2020-12-25 14:14
請參考.
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059

看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~

imingho

luckysan 發表於 2020-12-25 14:58
看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~

我先修改單一個的語法，您先看看是否看得懂，若懂的話，我再往下加功能。

1. Sub Copyandpastethendelete()
   
2. 
   
3.     Dim wsCopy As Worksheet
   
4.     Dim wsDest As Worksheet
   
5.     Dim lCopyLastRow As Long
   
6.     Dim lDestLastRow As Long
   
7. 
   
8.     Set wsCopy = Workbooks("範例.xlsm").Worksheets("泰C071")
   
9.     Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("泰C071")
   
10.    
    
11.    
    
12.     '1. Find last used row in the copy range based on data in column D
    
13.     lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
    
14.      
    
15.     '2. Find first blank row in the destination range based on data in column B
    
16.     'Offset property moves down 1 row
    
17.     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
    
18.    
    
19.     '3. Copy & Paste Data 範圍" "須自行對照key
    
20.     wsCopy.Range("B13:X" & lCopyLastRow).Copy _
    
21.       wsDest.Range("B" & lDestLastRow)
    
22.    
    
23.     '4. Clear contents of existing data range 範圍" "須自行對照key
    
24.     wsCopy.Range("B13:X" & lDestLastRow).ClearContents
    
25.    
    
26. End Sub

複製代碼

還有張貼程式碼請參考.如何在discuz張貼程式碼
http://discuz.bestdaylong.com/fo ... 30239&fromuid=2
(出處: 彰化一整天的論壇)

imingho

luckysan 發表於 2020-12-25 14:58
看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~

1. Sub Copyandpastethendelete()
   
2. 
   
3.     Dim wsCopy As Worksheet
   
4.     Dim wsDest As Worksheet
   
5.     Dim lCopyLastRow As Long
   
6.     Dim lDestLastRow As Long
   
7.    
   
8.     Dim i As Integer
   
9.    
   
10.     For i = 3 To Worksheets.Count
    
11. 
    
12.          Set wsCopy = Worksheets(i)
    
13.          Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets(i)
    
14.         
    
15.         
    
16.          '1. Find last used row in the copy range based on data in column D
    
17.          lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
    
18.          
    
19.          '2. Find first blank row in the destination range based on data in column B
    
20.          'Offset property moves down 1 row
    
21.          lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
    
22.         
    
23.          '3. Copy & Paste Data 範圍" "須自行對照key
    
24.          wsCopy.Range("B13:X" & lCopyLastRow).Copy _
    
25.            wsDest.Range("B" & lDestLastRow)
    
26.         
    
27.          '4. Clear contents of existing data range 範圍" "須自行對照key
    
28.          wsCopy.Range("B13:X" & lDestLastRow).ClearContents
    
29.    Next
    
30. End Sub
    

複製代碼

luckysan

imingho 發表於 2020-12-25 15:51

謝謝imingho大大, 我看的懂set那邊了,但是我實際測試後, 開啟範例與空白帳冊來執行, 卻出現有的工作表整個複製過去空白帳冊工作表的對應客戶工作表, 因為我只要複製沒有銷貨日期的資料範圍而已, 且在"範例"這個活頁簿裡面的客戶工作表, 裡面的資料我習慣一筆銷貨會空白一列,所以某些工作表,不一定是連續資料範圍, 再請imingoho大大看看在範例工作表其他工作表的資料分佈方式了,
例如菲C407 & 泰C071 工作表就是我所說的情況

imingho

luckysan 發表於 2020-12-25 16:44
謝謝imingho大大, 我看的懂set那邊了,但是我實際測試後, 開啟範例與空白帳冊來執行, 卻出現有的工作表整 ...

請修改如下試看看.

1. Sub Copyandpastethendelete()
   
2. 
   
3.     Dim wsCopy As Worksheet
   
4.     Dim wsDest As Worksheet
   
5.     Dim lCopyLastRow As Long
   
6.     Dim lCopyFirstRow As Long
   
7.     Dim lDestLastRow As Long
   
8. 
   
9.     Set wsCopy = Workbooks("範例.xlsm").Worksheets("菲C407")
   
10.     Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("菲C407")
    
11.    
    
12.     '1. Find last used row in the copy range based on data in column D
    
13.     lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
    
14.     lCopyFirstRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Offset(1).Row
    
15.     '2. Find first blank row in the destination range based on data in column B
    
16.     'Offset property moves down 1 row
    
17.     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
    
18.    
    
19.     '3. Copy & Paste Data 範圍" "須自行對照key
    
20.     wsCopy.Range("B" & lCopyFirstRow & ":X" & lCopyLastRow).Copy _
    
21.       wsDest.Range("B" & lDestLastRow)
    
22.    
    
23.     '4. Clear contents of existing data range 範圍" "須自行對照key
    
24.     wsCopy.Range("B" & lCopyFirstRow & ":X" & lCopyLastRow).ClearContents
    
25.    
    
26. End Sub
    

複製代碼

luckysan

imingho 發表於 2020-12-26 09:49
請修改如下試看看.

測試結果不行, 我只需要將還沒有銷貨資料的複製到空白帳冊而已,但您的程式中還會將已經銷貨的也帶到了空白帳冊去, 另外執行後,空白帳冊的一個客戶工作表,會多留一行空白列在B7那一列