返回列表 上一主題 發帖

[發問] 請高人幫忙除錯,謝謝~

回復 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

TOP

回復 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

TOP

回復 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最後一列的資料,

TOP

回復 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

已改了,成功了,謝謝

TOP

回復 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

TOP

回復 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

TOP

回復 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

TOP

回復 26# GBKEE

請問可否幫忙以下link 的問題,謝謝
  http://forum.twbts.com/thread-8512-1-1.html

TOP

回復 17# GBKEE

Data.rar (978.26 KB)

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到最後一筆,請問我應該如何改。

TOP

回復 30# GBKEE


我的五個DATA BASE�堶掖ㄛO以E欄作最後一筆資料,但之前的program好像是以A欄尋找最後一筆,對嗎?

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題