1234
返回列表 上一主題 發帖

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

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-4-16 00:32 | 只看該作者

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

想請問例如要將
1.              檔案1.xls內的第一個sheet內第二行的內容,使用巨集自動複製到另一個檔案2.xls內所在頁面的位置上需如何寫成巨集呢
收藏 分享

jackson7015

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

論壇贊助勳章
36#
發表於 2015-5-19 16:31 | 只看該作者
回復 35# GBKEE

感謝GBKEE版主的幫忙
原來要使用另一種寫法來定義範圍
謝謝前輩們的指教~

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
35#
發表於 2015-5-19 09:54 | 只看該作者
回復 34# jackson7015
反過來作
  1. With wbSh(1) '全年度資料庫"資料表的[綜合資料庫]
  2.         'Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
  3.         '***3.只貼上"值"的部分就好
  4.         .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
  5.         '複製範圍的總列數 Rng.Rows.Count
  6.         '複製範圍的總欄數 Rng.Columns.Count
  7.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jackson7015

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

論壇贊助勳章
34#
發表於 2015-5-19 09:32 | 只看該作者
回復 32# GBKEE
不好意思，想請教GBKEE版主
這條列試還是不會修改，可否幫忙看看
  1. Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
複製代碼
有加入過
  1. .PasteSpecial Paste:=xlPasteValues
複製代碼
不過語法錯誤..

抱歉，VB的能力真的很差
再請看看能否只貼上"值"，不需要格式條件

TOP

jackson7015

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

論壇贊助勳章
33#
發表於 2015-5-14 16:56 | 只看該作者
回復 32# GBKEE

感謝GBKEE版主的修正
    動作方面都OK了，不過貼上值的部分會連儲存格式也貼上去，累積下來的量會使儲存格式部份暴增
本想自己更正，不過不明白那一行的作用到底是怎麼運行的
只好在懇請板主幫忙了

原本以為是改正
  1.         '***3.只貼上"值"的部分就好
  2.         .UsedRange = .UsedRange.Value
複製代碼
不過查詢了一下，此代碼的作用好像都是解釋為'去除公式，所以不太明白怎麼更正...

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
32#
發表於 2015-5-14 09:33 | 只看該作者
回復 31# 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.         '***1.因AQ有時候會沒有設定值，所以能否只判斷A列有幾行，然後複製A5:AQ(A列最後一行)
  20.         'Set Rng = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp) ' 找末列
  21.         Set Rng = .Cells(.Rows.Count, "AQ").End(xlUp) ' 找末列
  22.         If .[A5].End(xlDown).Row > Rng.Row Then
  23.             Set Rng = .Range(.[A5], .Range("AQ" & .[A5].End(xlDown).Row))
  24.         Else
  25.             Set Rng = .Range(.[A5], Rng)
  26.         End If
  27.     End With
  28.     With wbSh(1) '全年度資料庫"資料表的[綜合資料庫]
  29.         Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
  30.         '***3.只貼上"值"的部分就好
  31.         .UsedRange = .UsedRange.Value
  32.     End With
  33.     '***2.只儲存關閉"全年度資料庫"
  34.     Workbooks(AR(1)).Close True   '全年度資料庫. 關閉且存檔
  35. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jackson7015

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

論壇贊助勳章
31#
發表於 2015-5-14 08:38 | 只看該作者
回復 30# GBKEE

感謝GBKEE版主修正後的版本
這版本程式碼比較簡單，而且有註譯也比較好讀了，不過有幾點可否幫忙要修正

1.因AQ有時候會沒有設定值，所以能否只判斷A列有幾行，然後複製A5:AQ(A列最後一行)
2.只儲存關閉"全年度資料庫"
3.只貼上"值"的部分就好
是否把
  1. Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
複製代碼
修正成
  1.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  2.         :=False, Transpose:=False
複製代碼

TOP

GBKEE

帖子
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
試試看
  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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jackson7015

帖子
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有值的最後一行
到
"全年度資料庫"資料表的[綜合資料庫]的空白處下方去了

是否可以再請幫忙看看哪裡有問題呢..
  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
複製代碼

TOP

GBKEE

帖子
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
試試看
  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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
1234
返回列表 上一主題