將資料自動複製到，目前點選的所在頁面並自動選擇最後一行空白處貼上 - Excel程式區

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

22^#

發表於 2015-4-20 21:37 | 只看該作者

回復 21# PKKO

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

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

23^#

發表於 2015-5-7 08:29 | 只看該作者

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

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

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

24^#

發表於 2015-5-8 23:53 | 只看該作者

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

Sub nn()
Dim lSRow&, lTRow&
Dim sPath$
Dim bNFind As Boolean
Dim wsSou As Worksheet, wsTar As Worksheet
Dim wbSou As Workbook, wbTar As Workbook
sPath = ThisWorkbook.Path
ChDrive sPath
ChDir sPath
Set wbSou = ThisWorkbook
Set wsSou = wbSou.Sheets("綜合資料庫")
bNFind = True
For Each wbTar In Workbooks ' 全年度資料庫檔案是否已開啟
If wbTar.Name = "全年度資料庫.xls" Then
Set wsTar = wbTar.Sheets("綜合資料庫")
bNFind = False
Exit For
End If
Next
If bNFind Then ' 若檔案未開啟則開啟它
With Workbooks.Open("全年度資料庫.xls", , True)
Set wbTar = ThisWorkbook
Set wsTar = .Sheets("綜合資料庫")
End With
End If
With wsSou
lSRow = .Cells(Rows.Count, [AQ1].Column).End(xlUp).Row ' 找末列
lTRow = wsTar.Cells(Rows.Count, 1).End(xlUp).Row
.Range([A5], .Cells(lSRow, [AQ1].Column)).Copy wsTar.Cells(lTRow, 1)
End With
End Sub

複製代碼

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

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

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

25^#

發表於 2015-5-12 09:04 | 只看該作者

回復 24# luhpro

感謝luhpro大大的回覆

巨集卡在

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

複製代碼

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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

26^#

發表於 2015-5-12 15:48 | 只看該作者

回復 25# jackson7015
是這樣嗎?

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

27^#

發表於 2015-5-12 16:16 | 只看該作者

本帖最後由 jackson7015 於 2015-5-12 16:17 編輯

回復 26# GBKEE

感謝GBKEE板大
原狀況排除了

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

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

複製代碼

下面的列式有錯誤

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

複製代碼

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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

28^#

發表於 2015-5-12 16:48 | 只看該作者

回復 27# jackson7015
試試看

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

29^#

發表於 2015-5-13 16:24 | 只看該作者

回復 28# GBKEE

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

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

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

Sub nn()
Dim lSRow&, lTRow&
Dim sPath$
Dim bNFind As Boolean
Dim wsSou As Worksheet, wsTar As Worksheet
Dim wbSou As Workbook, wbTar As Workbook
sPath = ThisWorkbook.Path
ChDrive sPath
ChDir sPath
Set wbSou = ThisWorkbook
Set wsSou = wbSou.Sheets("綜合資料庫")
bNFind = True
For Each wbTar In Workbooks ' 全年度資料庫檔案是否已開啟
If wbTar.Name = "全年度資料庫.xlsm" Then
Set wsTar = wbTar.Sheets("綜合資料庫")
bNFind = False
Exit For
End If
Next
If bNFind Then ' 若檔案未開啟則開啟它
With Workbooks.Open("全年度資料庫.xlsm", , True)
Set wbTar = ThisWorkbook
Set wsTar = .Sheets("綜合資料庫")
End With
End If
With wsTar
lSRow = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp).Row ' 找末列
lTRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.[A5], .Cells(lSRow, .[AQ4].Column)).Copy .Cells(lTRow, 1)
End With
End Sub

複製代碼

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

30^#

發表於 2015-5-14 07:58 | 只看該作者

回復 29# jackson7015
試試看

Option Explicit
Sub Ex()
Dim E As Variant, wbSh(1 To 2) As Worksheet, bNFind(1 To 2) As Boolean
Dim AR(1 To 2), xPath As String, Rng As Range
AR(1) = "全年度資料庫.xls" '檔案名稱
AR(2) = "當月報表.xls" '檔案名稱
xPath = "D:\" '檔案的路徑
For Each E In Workbooks '所有開啟的活頁簿物件集合
If E.Name = AR(1) Then bNFind(1) = True '全年度資料庫已開啟
If E.Name = AR(2) Then bNFind(2) = True '當月報表已開啟
Next
For E = 1 To UBound(bNFind)
If Not bNFind(E) Then '檔案未開啟
Workbooks.Open (xPath & AR(E))
End If
Set wbSh(E) = Workbooks(AR(E)).Sheets("綜合資料庫")
Next
With wbSh(2) '當月報表"中的[綜合資料庫]
Set Rng = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp) ' 找末列
Set Rng = .Range(.[A5], Rng)
End With
With wbSh(1) '全年度資料庫"資料表的[綜合資料庫]
Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
For Each E In AR
Workbooks(E).Close True '全年度資料庫,當月報表. 關閉且存檔
Next
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.