標題: 如何經由VB的按鈕 由一個EXCEL檔案資料匯入至另一EXCEL [打印本頁]

---

作者: g93353    時間: 2011-12-27 13:56     標題: 如何經由VB的按鈕 由一個EXCEL檔案資料匯入至另一EXCEL

想請問一下高手們


今天在EXCEL1.xls  新增了一個COMMAND

點擊後確認入徑後(  為另一個xls檔 :EX:  EXCEL2.xls )

就能將EXCEL2.xls裡的表格資料貼至EXCEL1.xls

想請問一下 VB的巨集要怎麼寫會比較好  

麻煩各位高手解答了>"<

---

作者: register313    時間: 2011-12-27 14:11

回復 1# g93353

工作表整張複製

1. Sub XX()
   
2. 
   
3. Source = Application.GetOpenFilename
   
4. With Workbooks.Open(Source)
   
5.    For i = 1 To ActiveWorkbook.Sheets.Count
   
6.     .Sheets(i).Copy after:=ThisWorkbook.Worksheets(Sheets.Count)
   
7.    Next i
   
8.   .Close
   
9. End With
   
10. 
    
11. End Sub

複製代碼

---

作者: g93353    時間: 2011-12-27 14:24

先謝謝高手的解答

可否再請問一下  若是只限定某範圍的表單 複製到 另一範圍的表單 要如何作修改
也是由EXCEL1  到 EXCEL2
(EX :  A1-10 B1-10 C1-10  要COPY至D2-11  E2-11 F2-11)

---

作者: register313    時間: 2011-12-27 14:48

回復 3# g93353

1. Sub XX()
   
2. 
   
3. Source = Application.GetOpenFilename
   
4. With Workbooks.Open(Source)
   
5.   .Sheets(1).Range("A1:C10").Copy ThisWorkbook.Sheets(1).Range("D2")
   
6.   .Close
   
7. End With
   
8. 
   
9. End Sub

複製代碼

---

作者: g93353    時間: 2011-12-27 15:05

感謝您的回答!!!!

---

作者: Changbanana    時間: 2016-9-7 14:11

回復 4# register313

測試過這個程式碼後有個問題想請問一下~

若從excel1複製過來的工作表，其名稱也會跟者複製到excel2耶

可以直接複製裡面的內容就好了嘛~~

或是複製過來自動更名為'data'

圖例:
[attach]25167[/attach]


下面的工作表名稱想要固定為'data'
而不會隨著從excel1複製過來的名稱而改變

---

作者: GBKEE    時間: 2016-9-7 15:01

回復 6# Changbanana
試試看

1. Option Explicit
   
2. Sub XX()
   
3.     Dim Source As String, Ar()
   
4.     Source = Application.GetOpenFilename
   
5.     With Workbooks.Open(Source)
   
6.         Ar = .Sheets(1).Range("A1:C10").Value
   
7.         .Close
   
8.     End With
   
9.     With ThisWorkbook.Sheets(1).Range("D2").Resize(UBound(Ar), UBound(Ar, 2))
   
10.         .Value = Ar
    
11.         .Name = "Data"
    
12.         .Select
    
13.     End With
    
14. End Sub

複製代碼

---

作者: Changbanana    時間: 2016-9-7 15:08

回復 7# GBKEE


感謝高手的答覆~

若資料沒有限定範圍~是整個工作表複製呢

那這樣該怎麼改


謝謝您~
(目前正在學習vba中所以有好多問題@@

---

作者: Changbanana    時間: 2016-9-7 15:17

回復 7# GBKEE

1. Sub XX()
   
2.     Dim Source As String, Ar()
   
3.     Source = Application.GetOpenFilename
   
4.     With Workbooks.Open(Source)
   
5.           Ar = .Sheets(1).Value
   
6.          .Close
   
7.     End With
   
8.     With ThisWorkbook.Sheets(1)
   
9.         .Value = Ar
   
10.         .Name = "Data"
    
11.         .Select
    
12.     End With
    
13. End Sub

複製代碼

在Ar = .Sheets(1).Value 出了問題

---

作者: Changbanana    時間: 2016-9-7 17:07

回復 7# GBKEE [/

剛之前在六樓回錯了
應該是要回覆二樓的程式
我表達的沒有很清楚抱歉

我的意思是(問題):

已在EXCEL1.xls  新增了一個COMMAND

點擊後確認入徑後(  為另一個xls檔 :EX:  EXCEL2.xls )

就能將EXCEL2.xls裡的全部資料(只有一個工作表資料範圍沒限制)貼至工作表名稱固定為'data'的EXCEL1.xls

------------------------------------------------
測試完二樓的程式後

EXCEL2.xls裡的全部資料是全部貼至EXCEL1.xls了

但是連工作表的名稱也貼過去了

因EXCEL2.xls 的工作表的名稱是會隨著儲存日期而改變
而EXCEL1.xls裡的工作表有額外做巨集
下列是有關在EXCEL1.xls裡寫到的程式碼

1. Sheets("工作表1").Select
   
2. Arr = Range([data!A2], [data!A65536].End(xlUp)(1, 65))

複製代碼

因為這樣故需要指定工作表的名稱
這樣巨集才可使用

---

作者: GBKEE    時間: 2016-9-9 14:02

回復 10# Changbanana
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Source As String, Ar()
   
4.     Source = Application.GetOpenFilename
   
5.     With Workbooks.Open(Source)
   
6.         Ar = .Sheets(1).UsedRange.Value
   
7.         .Close
   
8.     End With
   
9.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
   
10.         .Value = Ar
    
11.         .Name = "Data"
    
12.         .Select
    
13.     End With
    
14. End Sub

複製代碼

---

作者: Changbanana    時間: 2016-9-9 15:16

回復 11# GBKEE


感謝G大的大力相助
我昨天有試過你之前貼的程式碼

1. Private Sub Data_Click()
   
2. Dim Source As String, Ar()
   
3.     Source = Application.GetOpenFilename
   
4.     With Workbooks.Open(Source)
   
5.         Ar = .Sheets(1).Range("A1:BN65536").Value
   
6.         .Close
   
7.     End With
   
8.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
   
9.         .Value = Ar
   
10.         .Name = "data"
    
11.      End With
    
12.     End Sub

複製代碼

中間我直接讀取之前檔案全部儲存格內容
現在改成

1. Private Sub Data_Click()
   
2. Dim Source As String, Ar()
   
3.     Source = Application.GetOpenFilename
   
4.      With Workbooks.Open(Source)
   
5.         Ar = .Sheets(1).UsedRange.Value
   
6.         .Close
   
7.     End With
   
8.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
   
9.         .Value = Ar
   
10.         .Name = "data"
    
11.      End With
    
12. End Sub

複製代碼

從Range("A1:BN65536")改為UsedRange
這個方法快多了
有成功執行 真的很感謝你!!!!!

---

作者: white5168    時間: 2016-9-10 16:54

不建議使用UsedRange，如果遇到有空一大段的儲存格，那資料就無法完整匯出

---

作者: Changbanana    時間: 2016-9-22 11:37

回復 13# white5168
謝謝你的建議，已修正回來
回復 11# GBKEE
又有個疑問

若不要使用vb按鈕

直接應用檔案名字(在同個資料夾下)

就可以把資料匯入

這該怎麼修改呢?

ex:檔案名稱為==>測試.xlsx

---

作者: Changbanana    時間: 2016-9-22 11:46

這是我測試的code但有錯誤

1. Private Sub 測試()
   
2. Dim Source As String, Ar()
   
3.       Source = application.run(Activeworkbook.Name&"!測試")
   
4.       With Workbooks.Open(Source)
   
5.         Ar = .Sheets(1).Range("A1:D65536").value
   
6.         .Close
   
7.     End With
   
8.     With ThisWorkbook.Sheets("測試").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
   
9.         .value = Ar
   
10.         .Name = "測試"
    
11.      End With
    
12. 
    
13.     MsgBox "測試資料匯入成功"
    
14. End Sub

複製代碼

或是可否使用在資料表上設定一個儲存格的名稱為test
然後應用這個名稱 可以把檔案匯入進來

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)