如何經由VB的按鈕 由一個EXCEL檔案資料匯入至另一EXCEL

g93353

想請問一下高手們


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

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

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

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

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

Changbanana

這是我測試的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
然後應用這個名稱 可以把檔案匯入進來

Changbanana

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

若不要使用vb按鈕

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

就可以把資料匯入

這該怎麼修改呢?

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

white5168

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

Changbanana

回復 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
這個方法快多了
有成功執行 真的很感謝你!!!!!

GBKEE

回復 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

回復 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))

複製代碼

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

Changbanana

回復 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

回復 7# GBKEE


感謝高手的答覆~

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

那這樣該怎麼改


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

GBKEE

回復 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

複製代碼