PKKO

回復 14# starry1314

不指定Workbooks代表使用目前的活頁簿

    Sheets("客戶明細").Rows(2).Copy'代表目前使用活頁簿的"客戶明細"分頁的第二列進行複製
    EndRow = ActiveSheet.UsedRange.Rows.Count + 1 '所有使用中的列數+1
    Rows(EndRow).PasteSpecial Paste:=xlPasteValues'目前使用中的分頁,的最下方空白列貼上值

starry1314

回復 21# PKKO


   感謝說明～另外有個想法
我寫成一個檔案是固定檔名的好了，
例如這樣
固定（業務專用ｃ－客戶明細）　　　　不固定（客戶資料）　　讓固定（業務專用ｃ－客戶明細）可以去自己抓取不固定（客戶資料）內的第二個分頁第２行，會來貼在固定（業務專用ｃ－客戶明細）空白資料的最後一行
固定（業務專用ｂ－客戶明細）　　　　不固定（客戶資料）
固定（業務專用ａ－客戶明細）　　　　不固定（客戶資料）

jackson7015

想借提問固定檔案檔名的分頁資料複製問題
想從資料表"當月報表"中建立巨集，作用如 下
複製"當月報表"中的[綜合資料庫]的A5:AQ有值的最後一行
到
"全年度資料庫"資料表的[綜合資料庫]中的A列有值的下一行(空白處)

想詢問前輩們，以上巨集要如何編寫比較正確
如果沒有打開檔案"全年度資料庫"，請問會自動打開嗎?

luhpro

想借提問固定檔案檔名的分頁資料複製問題
想從資料表"當月報表"中建立巨集，作用如 下
複製"當月報表"中的 ...
jackson7015 發表於 2015-5-7 08:29

1. Sub nn()
   
2.   Dim lSRow&, lTRow&
   
3.   Dim sPath$
   
4.   Dim bNFind As Boolean
   
5.   Dim wsSou As Worksheet, wsTar As Worksheet
   
6.   Dim wbSou As Workbook, wbTar As Workbook
   
7.   
   
8. sPath = ThisWorkbook.Path
   
9. ChDrive sPath
   
10. ChDir sPath
    
11.   Set wbSou = ThisWorkbook
    
12.   Set wsSou = wbSou.Sheets("綜合資料庫")
    
13.   
    
14.   bNFind = True
    
15.   For Each wbTar In Workbooks ' 全年度資料庫 檔案是否已開啟
    
16.     If wbTar.Name = "全年度資料庫.xls" Then
    
17.       Set wsTar = wbTar.Sheets("綜合資料庫")
    
18.       bNFind = False
    
19.       Exit For
    
20.     End If
    
21.   Next
    
22.   If bNFind Then ' 若檔案未開啟則開啟它
    
23.     With Workbooks.Open("全年度資料庫.xls", , True)
    
24.       Set wbTar = ThisWorkbook
    
25.       Set wsTar = .Sheets("綜合資料庫")
    
26.     End With
    
27.   End If
    
28.   
    
29.   With wsSou
    
30.     lSRow = .Cells(Rows.Count, [AQ1].Column).End(xlUp).Row ' 找末列
    
31.     lTRow = wsTar.Cells(Rows.Count, 1).End(xlUp).Row
    
32.     .Range([A5], .Cells(lSRow, [AQ1].Column)).Copy wsTar.Cells(lTRow, 1)
    
33.   End With
    
34. End Sub

複製代碼

有些指令並無必要性,
只是一併列出來相關物件可以用怎樣的指令來取得.

若有先執行底下這三行,
sPath = ThisWorkbook.Path
ChDrive sPath
ChDir sPath
則只需要將檔案都放在同個目錄下,
讀檔指令中可以不用再給路徑.

jackson7015

回復 24# luhpro

感謝luhpro大大的回覆

巨集卡在

1. lSRow = .Cells(Rows.Count, [AQ1].Column).End(xlUp).Row ' 找末列

複製代碼

打開的全年度資料庫無誤
請問該如何排解?

GBKEE

回復 25# jackson7015
是這樣嗎?

1. lSRow = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp).Row ' 找末列

複製代碼

jackson7015

回復 26# GBKEE

感謝GBKEE板大
原狀況排除了

但是又出了新狀況...
我的因為A4:AQ4都有值，所以我把[CTRL+↓]的指令改成從AQ4開始(End(xlUp)的意思應該是這樣沒錯吧?)
但是還出現問題

1.     lTRow = wsTar.Cells(Rows.Count, 1).End(xlUp).Row
   
2.     .Range([A5], .Cells(lSRow, [AQ4].Column)).Copy wsTar.Cells(lTRow, 1)

複製代碼

下面的列式有錯誤

1.     .Range([A5], .Cells(lSRow, [AQ4].Column)).Copy wsTar.Cells(lTRow, 1)

複製代碼

再請前輩們分析看看
感謝~

GBKEE

回復 27# jackson7015
試試看

1. With wsTar
   
2.         lTRow = .Cells(.Rows.Count, 1).End(xlUp).Row
   
3.         .Range(.[A5], .Cells(lSRow, .[AQ4].Column)).Copy .Cells(lTRow, 1)
   
4.     End With

複製代碼

jackson7015

回復 28# GBKEE

先感謝GBKEE板主的回覆
錯誤訊息目前都排除了
但是卻出現沒有複製"當月報表"中的[綜合資料庫]到
"全年度資料庫"資料表的[綜合資料庫]中

反而出現
開啟"全年度資料庫"資料表的[綜合資料庫]中複製了a1:aq有值的最後一行
到
"全年度資料庫"資料表的[綜合資料庫]的空白處下方去了

是否可以再請幫忙看看哪裡有問題呢..

1. Sub nn()
   
2.   Dim lSRow&, lTRow&
   
3.   Dim sPath$
   
4.   Dim bNFind As Boolean
   
5.   Dim wsSou As Worksheet, wsTar As Worksheet
   
6.   Dim wbSou As Workbook, wbTar As Workbook
   
7.   
   
8. sPath = ThisWorkbook.Path
   
9. ChDrive sPath
   
10. ChDir sPath
    
11.   Set wbSou = ThisWorkbook
    
12.   Set wsSou = wbSou.Sheets("綜合資料庫")
    
13.   
    
14.   bNFind = True
    
15.   For Each wbTar In Workbooks ' 全年度資料庫 檔案是否已開啟
    
16.     If wbTar.Name = "全年度資料庫.xlsm" Then
    
17.       Set wsTar = wbTar.Sheets("綜合資料庫")
    
18.       bNFind = False
    
19.       Exit For
    
20.     End If
    
21.   Next
    
22.   If bNFind Then ' 若檔案未開啟則開啟它
    
23.     With Workbooks.Open("全年度資料庫.xlsm", , True)
    
24.       Set wbTar = ThisWorkbook
    
25.       Set wsTar = .Sheets("綜合資料庫")
    
26.     End With
    
27.   End If
    
28.   
    
29.   With wsTar
    
30.     lSRow = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp).Row ' 找末列
    
31.     lTRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    
32.     .Range(.[A5], .Cells(lSRow, .[AQ4].Column)).Copy .Cells(lTRow, 1)
    
33.   End With
    
34. End Sub

複製代碼

GBKEE

回復 29# jackson7015
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim E As Variant, wbSh(1 To 2) As Worksheet, bNFind(1 To 2) As Boolean
   
4.     Dim AR(1 To 2), xPath As String, Rng As Range
   
5.     AR(1) = "全年度資料庫.xls"        '檔案名稱
   
6.     AR(2) = "當月報表.xls"            '檔案名稱
   
7.     xPath = "D:\"                     '檔案的路徑
   
8.     For Each E In Workbooks           '所有開啟的活頁簿物件集合
   
9.         If E.Name = AR(1) Then bNFind(1) = True  '全年度資料庫 已開啟
   
10.         If E.Name = AR(2) Then bNFind(2) = True  '當月報表 已開啟
    
11.     Next
    
12.     For E = 1 To UBound(bNFind)
    
13.         If Not bNFind(E) Then              '檔案未開啟
    
14.             Workbooks.Open (xPath & AR(E))
    
15.         End If
    
16.         Set wbSh(E) = Workbooks(AR(E)).Sheets("綜合資料庫")
    
17.     Next
    
18.     With wbSh(2) '當月報表"中的[綜合資料庫]
    
19.         Set Rng = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp) ' 找末列
    
20.         Set Rng = .Range(.[A5], Rng)
    
21.     End With
    
22.     With wbSh(1) '全年度資料庫"資料表的[綜合資料庫]
    
23.         Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    
24.     End With
    
25.     For Each E In AR
    
26.         Workbooks(E).Close True   '全年度資料庫,當月報表. 關閉且存檔
    
27.     Next
    
28. End Sub

複製代碼