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

麻辣家族討論版版 » Excel程式區 » 將資料自動複製到，目前點選的所在頁面並自動選擇最後一行空白處貼上

返回列表下一主題上一主題發帖

[發問] 將資料自動複製到，目前點選的所在頁面並自動選擇最後一行空白處貼上

高中生 Rank: 3 Rank: 3

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

1^# 跳轉到 »

發表於 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
則只需要將檔案都放在同個目錄下,
讀檔指令中可以不用再給路徑.

靜思自在 : 唯其尊重自己的人，才更勇於縮小自己。

返回列表下一主題上一主題