Board logo

標題: [發問] 請高人幫忙除錯，謝謝~ [打印本頁]
作者: 198188    時間: 2012-12-2 10:38     標題: 請問有無高手可以做到這效果

設定定時將server 的幾個excel copy 在桌面？
例如：
server
Y:\2012\Jan\[a.xlsx]
Y:\2012\Feb\[b.xlsx]
Y:\2012\Mar\[c.xlsx]
Y:\2012\Apr\[d.xlsx]
Z:\2012\[e.xlsx]
將上面這些file copy 到下面地址：
C:\user\destop\
如果可以將FILE名改變成另一個名就更好
例如
[a.xlsx] 改成 1.xlsx
[b.xlsx] 改成 2.xlsx
[c.xlsx] 改成 3.xlsx
[d.xlsx] 改成 4.xlsx
[e.xlsx] 改成 5.xlsx

另外如果SERVER名每日不同可以嗎：
例如：
今日是2/Dec
server
Y:\2012\Jan\[a2-12.xlsx]
Y:\2012\Feb\[b2-12.xlsx]
Y:\2012\Mar\[c2-12.xlsx]
Y:\2012\Apr\[d2-12.xlsx]
Z:\2012\[e2-12.xlsx]

今日是3/Dec
server
Y:\2012\Jan\[a3-12.xlsx]
Y:\2012\Feb\[b3-12.xlsx]
Y:\2012\Mar\[c3-12.xlsx]
Y:\2012\Apr\[d3-12.xlsx]
Z:\2012\[e3-12.xlsx]
如此類推，名稱跟日期變動
作者: die78325    時間: 2012-12-2 12:41

回復 1# 198188

不知你的 [  ]是否是真實存在   在這我假設框是沒有的!
    Sub txet1()
'單純複製更名
VBA.FileCopy "Y:\2012\Jan\a.xlsx", "C:\user\destop\1.xlsx"
VBA.FileCopy "Y:\2012\Feb\b.xlsx", "C:\user\destop\2.xlsx"
VBA.FileCopy "Y:\2012\Mar\c.xlsx", "C:\user\destop\3.xlsx"
VBA.FileCopy "Y:\2012\Apr\d.xlsx", "C:\user\destop\4.xlsx"
VBA.FileCopy "Y:\2012\e.xlsx", "C:\user\destop\5.xlsx"
End Sub


如sever每日檔案會變動
需要在路徑加上判別今天 日期的語法
p =Format(Date, "d")&"-"&Format(Date, "m")
Format(Date, "d")  <-今天的日期 取"日"
Format(Date, "m") <-今天的日期 取"月"
所以理論上 就要 改為
VBA.FileCopy "Y:\2012\Jan\a& p & .xlsx", "C:\user\destop\1.xlsx"


名子不同這部分可能還要加以修正  因為要出門了 請其他大大幫我加以修正 感謝!!
Application.OnTime TimeValue("20:00:00"), "Module1.text1"
電腦時間到以上時間就執行模組 “ MODULE 1 ” 內的 “ text1 ” 這個程式
作者: 198188    時間: 2012-12-2 13:08

回復 2# die78325


    VBA.FileCopy "Y:\2012\Jan\a.xlsx", "C:\user\destop\1.xlsx"
如果copy 的file 不含VBA，是不是不用寫vba,只寫FileCopy "Y:\2012\Jan\a.xlsx", "C:\user\destop\1.xlsx"


Application.OnTime TimeValue("20:00:00"), "Module1.text1"
電腦時間到以上時間就執行模組 “ MODULE 1 ” 內的 “ text1 ” 這個程式
這個是不是指定20：00才copy，如果是半小時copy一次可以嗎？而桌面本身有這個file，是不是自動覆蓋舊的file?

那麼是不是將這個程式加在新的一個excel，還是放在想copy的excel內（a.xlsx  b.xlsx  c.xlsx  d.xlsx   e.xlsx）
作者: die78325    時間: 2012-12-2 23:25

回復 3# 198188


       回答第一題    沒錯   前面不需要vba.
   回答第二題    對  那句程式是只有在電腦右下角20:00:00的時候才會執行
     半小時的話  
     Application.OnTime Now + TimeValue("00:30:00"), "Module1.text1"
   回答第三題    會自動覆蓋
   回答第四題    不要在那abcde裡面放置vba   隨便一個excel內就好
作者: 198188    時間: 2012-12-3 09:36

回復 4# die78325


    感謝。
但我問的半小時，意思是每半小時自動做一次，不停地自動做。
你那句是否是這個意思？
作者: die78325    時間: 2012-12-3 10:14

回復 5# 198188


    是的   兩句語法不一樣! 請注意
Application.OnTime Now + TimeValue("00:30:00"), "Module1.text1"  '半小時

Application.OnTime TimeValue("20:00:00"), "Module1.text1"   '20:00:00執行
作者: 198188    時間: 2012-12-3 11:28

回復 6# die78325


1)  
Sub txet1()

P = Format(Date, "m") & "-" & Format(Date, "d")

FileCopy "Y:\2012\shipment 2012\ORACLE\ORACLESS & p & .xlsx", "C:\Users\patrick.HKG\Desktop\oracless.xlsx"

End Sub
出現 run-time error '53' file not found

2)
Sub txet1()


FileCopy "Y:\2012\shipment 2012\Mainland ETA Update.xlsx", "C:\Users\patrick.HKG\Desktop\Mainland ETA Update.xlsx"

FileCopy "Y:\2012\payment 2012\One Time Deposit list.xlsx", "C:\Users\patrick.HKG\Desktop\One Time Deposit list.xlsx"
FileCopy "Y:\2012\payment 2012\payment report 2012.xlsx", "C:\Users\patrick.HKG\Desktop\payment report 2012.xlsx"

FileCopy "Y:\2012\claim 2012\Claim control 20100106.xls", "C:\Users\patrick.HKG\Desktop\Claim control 20100106.xls"

FileCopy "Y:\2012\shipment 2012\HK ETA update.xlsx", "C:\Users\patrick.HKG\Desktop\HK ETA update.xlsx"
FileCopy "W:\PIHK\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx", "C:\Users\patrick.HKG\Desktop\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx"
FileCopy "Y:\2012\contract record 2012\daily doc.xlsx", "C:\Users\patrick.HKG\Desktop\daily doc.xlsx"
FileCopy "Y:\2012\shipment 2012\ORACLE\ORACLESS 11-28 .xlsx", "C:\Users\patrick.HKG\Desktop\oracless.xlsx"
End Sub

出現run-time error '70'  permission denied
作者: kimbal    時間: 2012-12-3 21:49

本帖最後由 kimbal 於 2012-12-3 21:54 編輯

回復 7# 198188


    1)  p 連接有誤
FileCopy "Y:\2012\shipment 2012\ORACLE\ORACLESS" & p & ".xlsx" , "C:\Users\patrick.HKG\Desktop\oracless.xlsx"

2) 字面上看是權限問題, 你試過手動抄上去無問題嗎? 目標的XLS有沒有正在打開? 打開的話會抄不上去
作者: 198188    時間: 2012-12-3 22:53

回復 8# kimbal

1)  p 需要SET什麼嗎？DIM P AS STRING 這類嗎？
Sub txet1()

P = Format(Date, "m") & "-" & Format(Date, "d")

FileCopy "Y:\2012\shipment 2012\ORACLE\ORACLESS" & p & ".xlsx" , "C:\Users\patrick.HKG\Desktop\oracless.xlsx"

End Sub



2) 字面上看是權限問題, 你試過手動抄上去無問題嗎? 目標的XLS有沒有正在打開? 打開的話會抄不上去
我是copy 捷徑上去的，一個一個copy上去，但一直都無問題，之後加上上面p那句後，就開始出現這些問題了。目標沒有打開。就算刪除p 那句後，也是這樣。
作者: 198188    時間: 2012-12-3 23:20

回復 8# kimbal


   另外請問如果copy不同的server會有問題嗎？
例如：
Y:\2012\NOV\1.XLSX
X:\SHIPMENT\A.XLSX

或者可否將不同的server內不同的excel,不同的sheet,copy在另外一個excel可以嗎？
括號內代表sheet名
Y:\2012\shipment 2012\Mainland ETA Update.xlsx (MAINLAN ETA)
Y:\2012\payment 2012\One Time Deposit list.xlsx (NOV)
Y:\2012\payment 2012\payment report 2012.xlsx (2012)
Y:\2012\claim 2012\Claim control 20100106.xlsx(2012)
Y:\2012\shipment 2012\HK ETA update.xlsx(HK ETA)
W:\PIHK\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx(RECEIVE)
Y:\2012\contract record 2012\daily doc.xlsx (DAILY DOCS)
Y:\2012\shipment 2012\ORACLE\ORACLESS 11-28 .xlsx(ORACLESS)

將以上的sheet 同時copy 在下面excel內可以嗎？每個sheet自動分開,用它們的excel名來命名sheet名
C:\Users\patrick.HKG\Desktop\Master.xlsx
作者: 198188    時間: 2012-12-4 11:22

回復 8# kimbal


  Sub txet1()
  P = Format(Date, "m") & "-" & Format(Date, "d") & "-" & Format(Date, "Y")
VBA.FileCopy "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\Outstanding Payments " & P & ".xlsm", "C:\users\patrick.hkg\desktop\outstanding payments.xlsm"
End Sub

我的file 名是 Outstanding Payments  12-4-2012
run 是出現run-time error '53': file not found

請問是哪裡出錯了？
作者: 198188    時間: 2012-12-4 13:03     標題: 請高人幫忙除錯，謝謝~

01.Option Explicit

02.Sub Ex()

03.   Dim Rng As Range

04.   'With Workbooks.Open("C:\USER\DESTOP\E.XLSX").Sheets("2012") '檔案未開啟時用此程式碼

05.   With Workbooks("E.XLSX").Sheets("2012")                      '檔案已開啟時用此程式碼

06.        'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料

07.        Set Rng = .[A2]

08.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案開啟

09.            .[A100:AM100].Copy Rng   “請問如果我的資料不停增加，超過100列，這句是不是需要改？

10.           .Parent.Close False                                  '檔案關閉

11.        End With

12.        'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料

13.        Set Rng = Rng.End(xlDown).Offset(1)  

14.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("Nov")    '檔案開啟

15.            .[A150:AM150].Copy Rng   “請問如果我的資料不停增加，超過150列，這句是不是需要改？

16.           .Parent.Close False                                  '檔案關閉

17.        End With

18.        'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料

19.        Set Rng = Rng.End(xlDown).Offset(1)

20.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案未開啟

21.            .[A270:AM270].Copy Rng   “請問如果我的資料不停增加，超過270列，這句是不是需要改？

22.           .Parent.Close False                                  '檔案關閉

23.        End With

24.    End With

25.End Sub



Set Rng = Rng.End(xlDown).Offset(1)  這句出現run-time error '1004' application-defined or object-defined error
.[A100:AM100].Copy Rng   “請問如果我的資料不停增加，超過100列，這句是不是需要改？
.[A150:AM150].Copy Rng   “請問如果我的資料不停增加，超過150列，這句是不是需要改？
.[A270:AM270].Copy Rng   “請問如果我的資料不停增加，超過270列，這句是不是需要改？
作者: 198188    時間: 2012-12-4 13:12     標題: 請教各位高手解決問題

1）Sub txet1()
   P = Format(Date, "m") & "-" & Format(Date, "d") & "-" & Format(Date, "Y")
VBA.FileCopy "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\Outstanding Payments " & P & ".xlsm", "C:\users\patrick.hkg\desktop\outstanding payments.xlsm"
End Sub

我的file 名是 Outstanding Payments  12-4-2012
run 是出現run-time error '53': file not found   請問是哪裡出錯了？
p 需要SET什麼嗎？DIM P AS STRING 之類嗎？

2）
Sub txet1()
FileCopy "W:\PIHK\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx", "C:\Users\patrick.HKG\Desktop\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx"
End Sub
是否因為file 名太長或者什麼原因，這句出現錯誤？或者是否因為我同時copy 另外一個Y server所以不行？

3）另外請問如果copy不同的server會有問題嗎？
例如：
Y:\2012\NOV\1.XLSX
X:\SHIPMENT\A.XLSX

或者可否將不同的server內不同的excel,不同的sheet,copy在另外一個excel可以嗎？
括號內代表sheet名
Y:\2012\shipment 2012\Mainland ETA Update.xlsx (MAINLAN ETA)
Y:\2012\payment 2012\One Time Deposit list.xlsx (NOV)
Y:\2012\payment 2012\payment report 2012.xlsx (2012)
Y:\2012\claim 2012\Claim control 20100106.xlsx(2012)
Y:\2012\shipment 2012\HK ETA update.xlsx(HK ETA)
W:\PIHK\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx(RECEIVE)
Y:\2012\contract record 2012\daily doc.xlsx (DAILY DOCS)
Y:\2012\shipment 2012\ORACLE\ORACLESS 11-28 .xlsx(ORACLESS)

將以上的sheet 同時copy 在下面excel內可以嗎？每個sheet自動分開,用它們的excel名來命名sheet名
C:\Users\patrick.HKG\Desktop\Master.xlsx
作者: GBKEE    時間: 2012-12-4 13:32

回復 11# 198188
我的file 名是 Outstanding Payments  12-4-2012
run 是出現run-time error '53': file not found
請檢查檔名
  1. Option Explicit
  2. Sub txet1()
  3.   Dim P As String, xfile As String
  4.   '我的file 名是 "Outstanding Payments  12-4-2012"
  5.   xfile = "Outstanding Payments  12-4-2012"  '
  6.   P = Format(Date, "M-D-YYYY")
  7.   P = "Outstanding Payments " & P & ".xls"
  8.   MsgBox xfile = P   '經比對 是 False 兩字串不相同
  9. End Sub
複製代碼
作者: 198188    時間: 2012-12-4 13:39

回復 13# GBKEE


  那麼是不是程式有問題，需要更改？
作者: 198188    時間: 2012-12-4 13:53

回復 13# GBKEE


    Option Explicit

Sub Ex()

   Dim Rng As Range

   'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\copy.xlsm").Sheets("2012") '檔案未開啟時用此程式碼

   With Workbooks("copy.xlsm").Sheets("2012")                      '檔案已開啟時用此程式碼

        'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料

        Set Rng = .[A2]  '第一個Rng

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\1.XLSX").Sheets("sheet1")    '檔案開啟

            .[A100:AM100].Copy Rng

           .Parent.Close False                                  '檔案關閉

       End With

        'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料

        Set Rng = Rng.End(xlDown).Offset(1)  '第二個Rng

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\2.XLSX").Sheets("sheet1")    '檔案開啟

            .[A150:AM150].Copy Rng

           .Parent.Close False                                  '檔案關閉

        End With

        'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料

        Set Rng = Rng.End(xlDown).Offset(1) '第三個Rng

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\3.XLSX").Sheets("sheet1")    '檔案未開啟

            .[A270:AM270].Copy Rng

           .Parent.Close False                                  '檔案關閉

        End With

    End With

End Sub

由於三個copy的對象每天都會增加資料，列數越來越多，下面這幾句需要改嗎？每個對象都是把第二列到最後一筆的資料copy過去
.[A100:AM100].Copy Rng
.[A150:AM150].Copy Rng
.[A270:AM270].Copy Rng

另外三個copy的對象的第一列不想copy過去，效果如下：
1.xlsx
SO Number        Acct Name        Deposit                      Ordered Date
207155                             ZCJ                                                 30-Oct-12
209428                             LJS                            30122.43                      7-Nov-12
200925                             LJH                            30000.77                      20-Jan-12
202101                         HAPPY TRADE            30000                      24-Feb-12
203906                            DFY                            30000                     11-May-12
208562                        ZWM2                                                 12-Oct-12
201532                            WGD                                                 10-Feb-12

2.xlsx
SO Number        Acct Name        Deposit                      Ordered Date
205218                         FZJ                                                                  26-Jan-12
204756                         CZX                                                                21-Oct-12
208563                         ZWM2                                                           19-Feb-12
207898                         ZWM2                                                           15-Feb-12

3.xlsx
SO Number        Acct Name        Deposit                      Ordered Date
205976                HMQ                            79983.09                      16-Jul-12
206034                           HMQ                            79983.09               16-Jul-12
203857                           LSH                            79974.19                       3-May-12
203858                           LSH                            79974.19                       3-May-12


copy.xlsm
SO Number        Acct Name        Deposit                      Ordered Date
207155                             ZCJ                                                 30-Oct-12
209428                             LJS                            30122.43                      7-Nov-12
200925                             LJH                            30000.77                      20-Jan-12
202101                         HAPPY TRADE            30000                      24-Feb-12
203906                            DFY                            30000                     11-May-12
208562                        ZWM2                                                 12-Oct-12
201532                            WGD                                                 10-Feb-12
205218                         FZJ                                                                  26-Jan-12
204756                         CZX                                                                21-Oct-12
208563                         ZWM2                                                           19-Feb-12
207898                         ZWM2                                                           15-Feb-12
205976                HMQ                            79983.09                      16-Jul-12
206034                           HMQ                            79983.09               16-Jul-12
203857                           LSH                            79974.19                       3-May-12
203858                           LSH                            79974.19                       3-May-12
作者: GBKEE    時間: 2012-12-4 13:53

本帖最後由 GBKEE 於 2012-12-4 13:54 編輯

回復 1# 198188
試試看
  1. Option Explicit
  2. Sub EX()
  3.    Dim Rng(1 To 2) As Range
  4.    'With Workbooks.Open("C:\USER\DESTOP\E.XLSX").Sheets("2012") '檔案未開啟時用此程式碼
  5.    With Workbooks("E.XLSX").Sheets("2012")                      '檔案已開啟時用此程式碼
  6.         
  7.        .Range("A1").CurrentRegion.Offset(1) = ""                '清除舊資料
  8.         
  9.         'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料
  10.         Set Rng(1) = .[A2]                                      '第一個Rng(1)
  11.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案開啟
  12.             Set Rng(2) = .[A2:AM2]
  13.             Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))     '資料不停增加: 到最後的資料
  14.             Rng(2).Copy Rng(1)
  15.            .Parent.Close False                                  '檔案關閉
  16.         End With
  17.         'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料
  18.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)               '第二個Rng(1)
  19.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("Nov")     '檔案開啟
  20.             Set Rng(2) = .[A101:AM101]
  21.             Set Rng(2) = .Range(Rng(2), .[AM101].End(xlDown))   '資料不停增加: 到最後的資料
  22.             Rng(2).Copy Rng(1)
  23.            .Parent.Close False                                  '檔案關閉
  24.         End With
  25.         'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料
  26.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)              '第三個Rng(1)
  27.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案未開啟
  28.             Set Rng(2) = .[A151:AM151]                          '第二列 開始
  29.             Set Rng(2) = .Range(Rng(2), .[AM151].End(xlDown))   '資料不停增加: 到最後的資料
  30.            .Parent.Close False                                  '檔案關閉
  31.         End With
  32.     End With
  33. End Sub
複製代碼
作者: GBKEE    時間: 2012-12-4 13:59

本帖最後由 GBKEE 於 2012-12-4 14:05 編輯

回復 15# 198188
你的檔案名稱最好不要有空格,容易在輸入檔名造成不正確,所以系統會找不到檔案
將檔案名稱修正好,再測試看看
作者: 198188    時間: 2012-12-4 14:21

回復 18# GBKEE


    Sub txet1()
'單純複製更名
P = Format(Date, "m") & "-" & Format(Date, "d") & "-" & Format(Date, "Y")

VBA.FileCopy "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\OutstandingPayments " & P & ".xlsm", "C:\users\patrick.hkg\desktop\outstandingpayments.xlsm"
End Sub

我將空格去掉後，也不行？file 名：OutstandingPayments12-4-2012.XLSM
作者: 198188    時間: 2012-12-4 14:55

回復 17# GBKEE


    01.Option Explicit

02.Sub EX()

03.   Dim Rng(1 To 2) As Range

04.   'With Workbooks.Open("C:\USER\DESTOP\E.XLSX").Sheets("2012") '檔案未開啟時用此程式碼

05.   With Workbooks("E.XLSX").Sheets("2012")                      '檔案已開啟時用此程式碼

06.        

07.       .Range("A1").CurrentRegion.Offset(1) = ""                '清除舊資料

08.        

09.        'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料

10.        Set Rng(1) = .[A2]                                      '第一個Rng(1)

11.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案開啟

12.            Set Rng(2) = .[A2:AM2]

13.            Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))     '資料不停增加: 到最後的資料

14.            Rng(2).Copy Rng(1)

15.           .Parent.Close False                                  '檔案關閉

16.        End With

17.        'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料

18.        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               '第二個Rng(1)

19.        With Workbooks.Open("Y:\2012\B.XLSX").Sheets("Nov")     '檔案開啟

20.            Set Rng(2) = .[A101:AM101]

21.            Set Rng(2) = .Range(Rng(2), .[AM101].End(xlDown))   '資料不停增加: 到最後的資料

22.            Rng(2).Copy Rng(1)

23.           .Parent.Close False                                  '檔案關閉

24.        End With

25.        'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料

26.        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              '第三個Rng(1)

27.        With Workbooks.Open("Z:\2012\C.XLSX").Sheets("2012")    '檔案未開啟

28.            Set Rng(2) = .[A151:AM151]                          '第二列 開始

29.            Set Rng(2) = .Range(Rng(2), .[AM151].End(xlDown))   '資料不停增加: 到最後的資料

30.           .Parent.Close False                                  '檔案關閉

31.        End With

32.    End With

33.End Sub

這裡有個誤會，我的意思是說copy的資料不知道是多少，之前提出的100，50 ，120是舉例。
With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")  自動從第二列開始copy過去，copy 的位置從第二列開始順序往下copy ,直到 A.XLSX最後一列的資料,
With Workbooks.Open("Y:\2012\B.XLSX").Sheets("Nov")    自動從第二列開始copy過去，copy 的位置承接上一個FILE A.XLSX的最後一列之後,直到 B.XLSX最後一列的資料,
With Workbooks.Open("Z:\2012\C.XLSX").Sheets("2012")  自動從第二列開始copy過去，copy 的位置承接上一個FILE B.XLSX的最後一列之後,直到 C.XLSX最後一列的資料,
作者: 198188    時間: 2012-12-4 15:09

回復 17# GBKEE


    Option Explicit

Sub copy()

   Dim Rng(1 To 2) As Range

   'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012") '檔案未開啟時用此程式碼

   With Workbooks("COPY.XLSM").Sheets("2012")                      '檔案已開啟時用此程式碼



       .Range("A1").CurrentRegion.Offset(1) = ""                '清除舊資料



        'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料

        Set Rng(1) = .[A2]                                      '第一個Rng(1)

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\1.XLSX").Sheets("SHEET1")    '檔案開啟

            Set Rng(2) = .[A2:AM2]

            Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))     '資料不停增加: 到最後的資料

            Rng(2).copy Rng(1)

           .Parent.Close False                                  '檔案關閉

        End With

        'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料

        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               '第二個Rng(1)

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\2.XLSX").Sheets("SHEET1")     '檔案開啟

            Set Rng(2) = .[A2:AM2]

            Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   '資料不停增加: 到最後的資料

            Rng(2).copy Rng(1)

           .Parent.Close False                                  '檔案關閉

        End With

        'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料

        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              '第三個Rng(1)

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\3.XLSX").Sheets("sheet1")    '檔案未開啟
            
             Set Rng(2) = .[A2:AM2]                          '第二列 開始

            Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   '資料不停增加: 到最後的資料
            
             Rng(2).copy Rng(1)

           .Parent.Close False                                  '檔案關閉

        End With

    End With

End Sub

已改了，成功了，謝謝
作者: 198188    時間: 2012-12-4 16:10

回復 18# GBKEE
請問可知道錯在哪裡？

    Sub txet1()
'單純複製更名
P = Format(Date, "m") & "-" & Format(Date, "d") & "-" & Format(Date, "Y")

VBA.FileCopy "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\OutstandingPayments " & P & ".xlsm", "C:\users\patrick.hkg\desktop\outstandingpayments.xlsm"
End Sub

我將空格去掉後，也不行？file 名：OutstandingPayments12-4-2012.XLSM
作者: GBKEE    時間: 2012-12-4 16:28

回復 22# 198188
錯在這裡
  1. Option Explicit
  2. Sub EX()
  3.     Dim P
  4.     P = Format(Date, "m") & "-" & Format(Date, "d") & "-" & Format(Date, "Y")
  5.     MsgBox P
  6.     P = Format(Date, "m-D-YYYY")
  7.     MsgBox P
  8. End Sub
複製代碼
作者: 198188    時間: 2012-12-4 17:43

回復 23# GBKEE

Sub copyfile()
'單純複製更名
Dim P

P = Format(Date, "m-D-YYYY")

VBA.FileCopy "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\Outstanding Payments" & P & ".xlsm", "C:\users\patrick.hkg\desktop\outstanding payments.xlsm"

End Sub

還是出現問題RUN-TIME ERROR'70': PERMISSION DENIED
作者: stillfish00    時間: 2012-12-4 19:30

本帖最後由 stillfish00 於 2012-12-4 19:31 編輯

回復 24# 198188
你可以手動複製更名看看是不是也出現錯誤
可能是檔案開啟中 或是 資料夾讀寫權限不足
作者: GBKEE    時間: 2012-12-5 07:15

回復 24# 198188
試試看
  1. Sub copyfile()
  2.     '單純複製更名
  3.     Dim xlfile As String
  4.     xlfile = "Y:\2012\payment 2012\Outstanding payment ss 2012\Dec 2012\Outstanding Payments" & Format(Date, "m-D-YYYY") & ".xlsm"
  5.     If Dir(xlfile) = "" Then
  6.         MsgBox "找不到 檔案"
  7.     Else
  8.         FileCopy xlfile, "C:\users\patrick.hkg\desktop\outstanding payments.xlsm"
  9.     End If
  10. End Sub
複製代碼
作者: 198188    時間: 2012-12-5 23:44

回復 8# kimbal


請問可否將不同的server內不同的excel,不同的sheet,copy在另外一個excel可以嗎？
括號內代表sheet名
Y:\2012\shipment 2012\Mainland ETA Update.xlsx (MAINLAN ETA)
Y:\2012\payment 2012\One Time Deposit list.xlsx (NOV)
Y:\2012\payment 2012\payment report 2012.xlsx (2012)
Y:\2012\claim 2012\Claim control 20100106.xlsx(2012)
Y:\2012\shipment 2012\HK ETA update.xlsx(HK ETA)
W:\PIHK\NEW 香港辦公室正本收放單記錄-FROM 01-MAR-2012 to current(updated).xlsx(RECEIVE)
Y:\2012\contract record 2012\daily doc.xlsx (DAILY DOCS)
Y:\2012\shipment 2012\ORACLE\ORACLESS 11-28 .xlsx(ORACLESS)

將以上的sheet 同時copy 在下面excel內可以嗎？每個sheet自動分開,用它們的excel名來命名sheet名
C:\Users\patrick.HKG\Desktop\Master.xlsx
作者: 198188    時間: 2012-12-6 08:59

回復 26# GBKEE

請問可否幫忙以下link 的問題，謝謝
  http://forum.twbts.com/thread-8512-1-1.html
作者: 198188    時間: 2012-12-6 14:32

回復 17# GBKEE

[attach]13409[/attach]

Sub copy()

   Dim Rng(1 To 2) As Range

   'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012")
    With Workbooks("payment.XLSM").Sheets("2012")                  
       .Range("A1").CurrentRegion.Offset(1) = ""            

         Set Rng(1) = .[A2]
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")   
             Set Rng(2) = .[A2:AL2]
             Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))     
             Rng(2).copy Rng(1)
           .Parent.Close False                                 
         End With

         Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")     
             Set Rng(2) = .[A2:AL2]
             Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   
            Rng(2).copy Rng(1)
            .Parent.Close False                                 
        End With

        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("sheet1")
         Set Rng(2) = .[A2:AL2]                       
       Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))               
             Rng(2).copy Rng(1)
            .Parent.Close False        
        End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)            
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("sheet1")               
             Set Rng(2) = .[A2:AL2]           
       Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))               
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("sheet1")               
             Set Rng(2) = .[A2:AL2]                          
       Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
         End With
End Sub


由於我的data base沒有是E欄才可以check到最後一筆，請問我應該如何改。
作者: GBKEE    時間: 2012-12-6 14:42

回復 29# 198188
由於我的data base沒有是E欄才可以check到最後一筆，請問我應該如何改。
沒有是E欄 是何意
作者: 198188    時間: 2012-12-6 15:04

回復 30# GBKEE


我的五個DATA BASE裏面都是以E欄作最後一筆資料，但之前的program好像是以A欄尋找最後一筆，對嗎？
作者: GBKEE    時間: 2012-12-6 15:34

回復 31# 198188
  1. Set Rng(2) = .[A2:AL2]
  2.     'Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))
  3.     Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  4.     'Resize 屬性 調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
複製代碼
作者: 198188    時間: 2012-12-6 17:02

回復 32# GBKEE

Option Explicit

Sub copy()

   Dim Rng(1 To 2) As Range

   'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012")

   With Workbooks("payment.XLSM").Sheets("2012")                     


       .Range("A1").CurrentRegion.Offset(1) = ""               




        Set Rng(1) = .[A2]                                    
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")                 
             Set Rng(2) = .[A2:AL2]                        
       Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))

  

            Rng(2).copy Rng(1)

           .Parent.Close False                                 

        End With

        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")     
           Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

           Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1)

           .Parent.Close False                                 
        End With

      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)            
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("sheet1")               
            Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

           Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
            
             Rng(2).copy Rng(1)

           .Parent.Close False                                 
        End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("sheet1")   
            
             Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

           Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
            
             Rng(2).copy Rng(1)

           .Parent.Close False                                 

        End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("sheet1")   
            
        
           Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

           Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
            
             Rng(2).copy Rng(1)

           .Parent.Close False                                 

        End With
      

    End With

End Sub

Set Rng(1) = Rng(1).End(xlDown).Offset(1)      出現ERROR :RUN-TIME ERROR '1004'; APPLICATION-DEFINED OR OBJECT-DEFINED ERROR
作者: 198188    時間: 2012-12-7 09:02

回復 32# GBKEE


    Set Rng(1) = Rng(1).End(xlDown).Offset(1)      出現ERROR :RUN-TIME ERROR '1004'; APPLICATION-DEFINED OR OBJECT-DEFINED ERROR
請問是哪裏有問題？
作者: GBKEE    時間: 2012-12-7 09:45

本帖最後由 GBKEE 於 2012-12-7 09:47 編輯

回復 34# 198188
修改錯誤點
  1.      If  Rng(1).End(xlDown).Row <> Rng(1).Parent.Rows.Count Then
  2.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
  3.     Else
  4.         MsgBox "已到檔案底部 無法新增資料"
  5.        Exit Sub
  6.     End If
複製代碼
作者: 198188    時間: 2012-12-7 10:30

回復 35# GBKEE


    這麼快到底部嗎？我的資料才幾十列？
作者: 198188    時間: 2012-12-7 11:21

回復 35# GBKEE


    Set Rng(1) = .[A2]
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")
              Set Rng(2) = .[A2:AL2]
       Set Rng(2) = .Range(Rng(2), .[e2].End(xlDown))

   

             Rng(2).copy Rng(1)

            .Parent.Close False

        End With

         
         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")
            Set Rng(2) = .[A2:AL2]

            Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1)

            .Parent.Close False
        End With
會不會因為之前是用A欄來計算最後一筆，但現在我改成用E欄檢查最後一筆，而 Set Rng(1) = Rng(1).End(xlDown).Offset(1)這句話是用A欄來設定？
Set Rng(1) = .[A2]
Set Rng(1) = Rng(1).End(xlDown).Offset(1)
作者: 198188    時間: 2012-12-7 13:58

回復 35# GBKEE

[attach]13425[/attach][attach]13426[/attach][attach]13427[/attach][attach]13428[/attach][attach]13429[/attach][attach]13430[/attach]
Option Explicit
Sub copy()
   Dim Rng(1 To 2) As Range
    'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012")
    With Workbooks("payment.XLSM").Sheets("2012")                     
        .Range("A1").CurrentRegion.Offset(1) = ""               
        Set Rng(1) = .[a2]                                      
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")   
             Set Rng(2) = .[A2:L2]
             Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))     
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")     
            Set Rng(2) = .[A2:L2]
            Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
            Rng(2).copy Rng(1)
            .Parent.Close False                                   
        End With
         Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("sheet1")   
             Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("sheet1")                 Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                  
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("sheet1")   
             Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
    End With
End Sub
  我用了上面的程式，但出來的result卻無法全部出來。請問哪裡需要改？
作者: GBKEE    時間: 2012-12-7 17:07

回復 38# 198188
  1. Option Explicit
  2. Sub Ex() '程序名稱不要用 copy 這是vba方法的關鍵字
  3.    Dim Rng(1 To 2) As Range
  4.      With Workbooks("payment.XLSM").Sheets("2012")
  5.          .Range("A1").CurrentRegion.Offset(1) = ""
  6.         Set Rng(1) = .[E2]  'E欄資料有連續
  7.        'MsgBox Rng(1).Cells(1, -3).Address '回到A欄
  8.          With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")
  9.              Set Rng(2) = .[A2:L2]
  10.              Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  11.              Rng(2).copy Rng(1).Cells(1, -3)   'A欄
  12.             .Parent.Close False
  13.          End With
  14.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
  15.          With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")
  16.             Set Rng(2) = .[A2:L2]
  17.            ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用
  18.             Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  19.             Rng(2).copy Rng(1).Cells(1, -3)
  20.             .Parent.Close False
  21.         End With
  22.         '
  23.         '
  24.         ' 以下同
  25.         '
  26.         '
  27.         

  29.       End With
  30. End Sub
複製代碼
作者: 198188    時間: 2012-12-7 17:35

回復 39# GBKEE


    Option Explicit

Sub Ex() '程序名稱不要用 copy 這是vba方法的關鍵字


   Dim Rng(1 To 2) As Range

     With Workbooks("payment.XLSM").Sheets("2012")

         .Range("A1").CurrentRegion.Offset(1) = ""

        Set Rng(1) = .[E2]  'E欄資料有連續

       'MsgBox Rng(1).Cells(1, -3).Address '回到A欄

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("SHEET1")

             Set Rng(2) = .[A2:L2]

             Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

             Rng(2).copy Rng(1).Cells(1, -3)   'A欄

            .Parent.Close False

         End With

        Set Rng(1) = Rng(1).End(xlDown).Offset(1)

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)     '程式run 到這裡出現問題 application-defined or object-defined error

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
End With

End Sub
最後一個出現問題
   Set Rng(1) = Rng(1).End(xlDown).Offset(1)     '程式run 到這裡出現問題 application-defined or object-defined error
另外中間有一列空格，之後的資料就無法出來。但第一次的程式，在copy 第一個excel 就算中間有一列空格，它也可以往下copy?
作者: 198188    時間: 2012-12-8 00:57

[attach]13441[/attach][attach]13442[/attach][attach]13443[/attach]

請問哪裡出錯了？Rng(2).copy Rng(1)
作者: GBKEE    時間: 2012-12-8 08:00

回復 40# 198188
With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("SHEET1")
將此檔案與未出錯檔案對調看是否一樣的出錯,可依下方程序看看

回復 41# 198188
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range
  4.     With Workbooks("payment.XLSM").Sheets("2012")
  5.         Set Rng(1) = .[E1000].End(xlUp).Offset(, -4) '這 Rng(1)的位置
  6.         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("SHEET1")
  7.             Set Rng(2) = .[A2:L2]
  8.             Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))
  9.             MsgBox .Rows.Count - Rng(2).Rows.Count < .Rows.Count - Rng(1).Row 'True: Rng(2)範圍大於 Rng(1) 就有錯誤
  10.             Rng(2).Copy Rng(1)
  11.             .Parent.Close False
  12.         End With
  13.     End With
  14. End Sub
複製代碼
作者: 198188    時間: 2012-12-8 09:40

回復 42# GBKEE


    01.Option Explicit

02.Sub Ex()

03.    Dim Rng(1 To 2) As Range

04.    With Workbooks("payment.XLSM").Sheets("2012")

05.        Set Rng(1) = .[E1000].End(xlUp).Offset(, -4) '這 Rng(1)的位置

06.        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("SHEET1")

07.            Set Rng(2) = .[A2:L2]

08.            Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))

09.            MsgBox .Rows.Count - Rng(2).Rows.Count < .Rows.Count - Rng(1).Row 'True: Rng(2)範圍大於 Rng(1) 就有錯誤

10.            Rng(2).Copy Rng(1)

11.            .Parent.Close False

12.        End With

13.    End With

14.End Sub
是Rng(2)範圍大於 Rng(1)，但是Set Rng(1) = .[E1000].End(xlUp).Offset(, -4) '這 Rng(1)的位置 （這句的意思是不是等於由E1000開始往上檢查最後一列，OFFSET( , -4)將E欄改成A欄
Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))是否意思從A欄第二列開始往下到最後一筆？
作者: GBKEE    時間: 2012-12-8 09:52

回復 43# 198188
Set Rng(1) = .[E1000].End(xlUp):  E1000開始往上檢查最後一列=> 如是 E999
Set Rng(1) = .[E1000].End(xlUp).Offset(, -4) => A999
那 A999 到 檔案底部 的列數是 2003-> 65536-999 +1
*********
Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))
A欄第二列開始往下到最後一筆範圍的列數 ?? 如大於 65536-999 +1
********** 複製的資料範圍>貼上位置的範圍 ?? 那多出的資料要擺哪裡 ??****
作者: 198188    時間: 2012-12-8 10:25

回復 44# GBKEE


    Set Rng(1) = .[E1000].End(xlUp):  E1000開始往上檢查最後一列=> 如是 E999
那麼請問我應該如何寫這句，將它寫成set rng(1) = 當前worksheet(2012)E 欄的最後一列加1？
其實我A欄大部分都沒有資料
作者: 198188    時間: 2012-12-8 10:33

回復 44# GBKEE


    Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))
A欄第二列開始往下到最後一筆範圍的列數 ?? 如大於 65536-999 +1
********** 複製的資料範圍>貼上位置的範圍 ?? 那多出的資料要擺哪裡 ??****
或者
這句可否改成A欄第二列開始往下到最後一筆範圍的列數,但基於有時會隔開一列，可否加多句找到最後一筆的那列後加兩列，如果也沒有資料，才確認是最後一筆，否則繼續往下開始
作者: GBKEE    時間: 2012-12-8 10:44

本帖最後由 GBKEE 於 2012-12-8 10:45 編輯

回復 46# 198188
41# 的錯誤在
  1.           Set Rng(2) = .[A2:L2]
  2.           Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   'A欄沒資料 [A2].End(xlDown) 會到檔案底部
複製代碼
39# 已提醒你: 給你的程式碼要消化一下,VBA才會進步
  1.    
  2.           Set Rng(1) = .[E2]  'E欄資料有連續
  3.          '
  4.          '
  5.            Set Rng(2) = .[A2:L2]
  6.           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用
  7.             Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)  
  8.            '[E1].End(xlDown) 到E欄有資料的地方會停止,才不會到檔案底部
  9.             Rng(2).copy Rng(1).Cells(1, -3)
複製代碼
作者: 198188    時間: 2012-12-8 11:04

回復 47# GBKEE


   感激解釋，
但是我試過除了剛才這句 Set Rng(1) = Rng(1).End(xlDown).Offset(1)出現問題外，當我E欄中間有一列空白，就不懂往下copy，所以才用A欄，明白原理，但就是轉不過來怎樣改？

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Patrick.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).Copy Rng(1).Cells(1, -3)

            .Parent.Close False
作者: 198188    時間: 2012-12-8 11:08

回復 47# GBKEE


    正如第38貼Patrick.XLSX，E 欄只有幾欄資料怎會超出範圍？Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)這句以什麼作為規則？
作者: GBKEE    時間: 2012-12-8 12:36

回復 48# 198188
當我E欄中間有一列空白: 可由檔案底部往上
  1.     Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)
  2.     Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)
複製代碼
回復 49# 198188
VBA 的說明
  1. Resize 屬性
  2. 請參閱套用至範例特定調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
  3. expression.Resize(RowSize, ColumnSize)
  4. expression     必選。該運算式傳回要調整大小的 Range 物件。
  5. RowSize     選擇性的 Variant。新範圍中所包含的列數。如果省略此引數，範圍中的列數保持不變。
  6. ColumnSize     選擇性的 Variant。新範圍中所包含的欄數。如果省略此引數，範圍中的欄數保持不變。
複製代碼
  1. For xi = 1 To 5
  2.         Set Rng(2) = Rng(2).Resize(xi)
  3.         MsgBox Rng(2).Address
  4.     Next
複製代碼
作者: 198188    時間: 2012-12-8 15:00

回復 50# GBKEE


    原來是這樣寫Range("e" & …我就是想不通怎樣用語法表達這句話!之前還想E1000來表示，但放錯在上一句
作者: 198188    時間: 2012-12-8 21:37

回復 50# GBKEE


    Option Explicit

Sub Ex()

   Dim Rng(1 To 2) As Range
   
   
     With Workbooks("payment.XLSM").Sheets("2012")
         Sheets("2012").Range("A2:L65536").ClearContents
         Sheets("2012").Range("A2:L65536").Interior.Color = xlNone

         .Range("A1").CurrentRegion.Offset(1) = ""
         
        Set Rng(1) = .[e2]

             With Workbooks.Open("C:\Documents and Settings\USER\桌面\Connie.XLSX").Sheets("SHEET1")

             Set Rng(2) = .[A2:L2]

             Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

             Rng(2).copy Rng(1).Cells(1, -3)
            
             .Parent.Close False

         End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)
        
         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Lily.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Jane.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]
            
            Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

            Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)
        
         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Jenny.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Patrick.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
End With

End Sub

經過改良後，成功了，就成效寫出來與大家分享~~
作者: GBKEE    時間: 2012-12-9 08:07

回復 52# 198188

    [attach]13468[/attach]


如圖操作可方便他人複製程式碼
簡化你的程式碼
  1. Option Explicit
  2. Sub Ex()
  3.    Dim Rng(1 To 2) As Range, Files_AR(), E As Variant
  4.      Files_AR = Array("Connie.XLSX", "Lily.XLSX", "Jane.XLSX", "Jenny.XLSX")
  5.                                                                        '檔案名稱置入陣列:簡化程式的書寫
  6.      With Workbooks("payment.XLSM").Sheets("2012")
  7.         .Range("A2:L65536").ClearContents
  8.         .Range("A2:L65536").Interior.Color = xlNone
  9.         .Range("A1").CurrentRegion.Offset(1) = ""                       '清除A1連續範圍Offset(1):第一列以後連續範圍資料
  10.         For Each E In Files_AR                                          '迴圈取同一資料夾的檔案
  11.             Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(1)  'Offset(2)=> 本身算起如是E1-> E3
  12.             With Workbooks.Open("C:\Documents and Settings\USER\桌面\" & E).Sheets("SHEET1")
  13.                 Set Rng(2) = .[A2:L2]
  14.                 Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)
  15.                 Rng(2).Copy Rng(1).Cells(1, -3)
  16.                 .Parent.Close False
  17.             End With
  18.          Next
  19.     End With
  20. End Sub
複製代碼
作者: 198188    時間: 2012-12-9 09:12

回復 53# GBKEE


    請問為何這個file會有10MB，只有這個程式，其他的都沒有？



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)