Dùng ADO để copy sheet chỉ định của nhiều file trong cùng một thư mục

[Thien]

Thân chào các Anh Chị Em trong diễn đàn.

Hiện tại mình có 12 file được đặt trong cùng 1 thư mục, trong mỗi file có tên sheet muốn copy giống nhau.

Nay mình muốn dùng ADO để copy sheet từ 12 file (đang đóng) đó sang 1 file hiện hành.

Rất mong nhận được giúp đỡ.

Trân trọng cảm ơn và thân chào

 

[sealand]

Mình định viết bài trả lời, vậy mà mở file đố ai thấy dữ liệu sheetA đâu ?

Đây là câu trả lời 3 trong 1http://www.giaiphapexcel.com/forum/...-rút-dữ-liệu-trong-Excel.&p=344802#post344802 cho bạn, mình muốn để riêng Topic để các bạn GPE góp ý bổ xung thêm cho từng cách.

 

[Thien]

Chào Anh sealand

Em gửi file ví dụ lên nhờ Anh giúp hộ

Chân thành cảm ơn Anh

Thân chào

 

[sealand]

Đúng ra, 1 bảng của 1 CSDL làm gì có tiêu đề có công thức để trả về giá trị lỗi tràn lan. Đã vậy lại còn chân cộng nữa chứ.
Thôi thì mình cứ làm 1 cái việc là chép hết sang còn tuỳ bạn sử lý.
Trong file tổng bạn nhấn Ctrl+m là chạy code

 

[tuangiang25022008]

các bạn giúp mình chuyển dữ liệu sang excel 2007 với.

đây là file 2003 nhưng với dữ liệu 2007 thì mình không làm được.
các bạn giúp mình với.
Nếu file này save as sang 2003 thì dùng được.
vì dữ liệu mình rất lớn
nếu dùng 2003 thì không thể dùng được
mong các bạn giúp mình

 

[ndu96081631]

đây là file 2003 nhưng với dữ liệu 2007 thì mình không làm được.
các bạn giúp mình với.
Nếu file này save as sang 2003 thì dùng được.
vì dữ liệu mình rất lớn
nếu dùng 2003 thì không thể dùng được
mong các bạn giúp mình

Thử sửa lại thành vầy xem:

Sub ADO_EXCEL()
  Dim cn As ADODB.Connection, rs As ADODB.Recordset
  Dim strcn As String, strSQL As String, i
  Dim FileNguon, FileName(), ShName()
  FileName = Array("TL01_11.[B][COLOR=#ff0000]xlsx[/COLOR][/B]", "TL02_11.[B][COLOR=#ff0000]xlsx[/COLOR][/B]", "TL03_11.[B][COLOR=#ff0000]xlsx[/COLOR][/B]")
  ShName = Array("TH-Z1", "TH-Z2", "TH-Z3")
  For i = 0 To UBound(FileName)
    FileNguon = ThisWorkbook.Path & "\" & FileName(i)
    [COLOR=#ff0000][B]If Val(Application.Version) < 12 Then
      strcn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileNguon & ";" & _
              "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
    Else
      strcn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileNguon & ";" & _
                "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"""
    End If[/B][/COLOR]
    strSQL = "SELECT * FROM [TH-Z$]"
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    cn.Open strcn
    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenKeyset, adLockReadOnly
    With Worksheets(ShName(i))
      .Cells.ClearContents
      .[A1].CopyFromRecordset rs
      .Columns.AutoFit
    End With
  Next
  rs.Close: Set rs = Nothing
  cn.Close: Set cn = Nothing
End Sub

Chổ màu đỏ là những chổ sửa lại

 

[tuangiang25022008]

thanks NDU nhiều
chúc bạn luôn may mắn và hạnh phúc trong cuộc sống.
thân
Nguyễn Tuấn Giang

 

[tuangiang25022008]

Thanhks
Cám ơn bạn nhiều