Xin hướng dẫn code động lấy dữ liệu từ 1 file đang đóng

bjboyn00b · 18/11/22

Chào mọi người, mình có tìm hiểu các code ở trên mạng nhưng chưa có code nào phù hợp, mình đang cần 1 code để thực thi lệnh như sau:
Từ file hiện hành, VBA mở lên cửa sổ chọn file cần lấy dữ liệu ( file cần lấy dữ liệu không cố định tên, chỉ có 1 sheet, cửa sổ hiện lên chọn file là cùng đường dẫn chứa file hiện hành), copy toàn bộ dữ liệu ở file cần lấy vào 1 sheet của file hiện hành .

Mình có tìm hiểu là đặt biến cho đường dẫn mà làm mãi không được

Mong mọi người giúp đỡ.
Xin cảm ơn.

huhumalu · 18/11/22

Bài của anh Hai Lúa nè

Copy dữ liệu từ file đang đóng

Hiện tại em em có 2 file cấu trúc dữ liệu giống nhau nhưng không nằm trên 1 foder. Em muốn copy toàn bộ dữ liệu của file "File du lieu" sang file " TONGHOP". Cũng tìm hiểu trên diễn đàn nhưng khi làm lại không ra kết quả được. Chính vì vậy nhờ các thầy cô kiểm tra giúp module trong file TONGHOP...

www.giaiphapexcel.com

Bạn xem thử

snow25 · 18/11/22

bjboyn00b đã viết:
Chào mọi người, mình có tìm hiểu các code ở trên mạng nhưng chưa có code nào phù hợp, mình đang cần 1 code để thực thi lệnh như sau:
Từ file hiện hành, VBA mở lên cửa sổ chọn file cần lấy dữ liệu ( file cần lấy dữ liệu không cố định tên, chỉ có 1 sheet, cửa sổ hiện lên chọn file là cùng đường dẫn chứa file hiện hành), copy toàn bộ dữ liệu ở file cần lấy vào 1 sheet của file hiện hành .

Mình có tìm hiểu là đặt biến cho đường dẫn mà làm mãi không được
Mong mọi người giúp đỡ.
Xin cảm ơn.

Thử xem cái này nghiên cứu xem.

Liên kết: https://youtu.be/jPa491Bp7KU

hvnhpro · 18/11/22

bjboyn00b đã viết:
Chào mọi người, mình có tìm hiểu các code ở trên mạng nhưng chưa có code nào phù hợp, mình đang cần 1 code để thực thi lệnh như sau:
Từ file hiện hành, VBA mở lên cửa sổ chọn file cần lấy dữ liệu ( file cần lấy dữ liệu không cố định tên, chỉ có 1 sheet, cửa sổ hiện lên chọn file là cùng đường dẫn chứa file hiện hành), copy toàn bộ dữ liệu ở file cần lấy vào 1 sheet của file hiện hành .

Mình có tìm hiểu là đặt biến cho đường dẫn mà làm mãi không được
Mong mọi người giúp đỡ.
Xin cảm ơn.

ý bạn là cần đoạn code cố định đường dẫn khi "cửa sổ chọn file cần lấy dữ liệu".
bạn cho đoạn này

ChDrive "D:"
ChDir "D:\link Folder bạn cần

vào trước dòng này nhé
Application.GetOpenFilename

bjboyn00b · 19/11/22

hvnhpro đã viết:
ý bạn là cần đoạn code cố định đường dẫn khi "cửa sổ chọn file cần lấy dữ liệu".
bạn cho đoạn này

ChDrive "D:"
ChDir "D:\link Folder bạn cần

vào trước dòng này nhé
Application.GetOpenFilename

Cảm ơn bác, em đang sử dụng code sau, em thấy báo sai khi đặt biến lastrow, em xem lại không hiểu sai ở đâu, có gì bác xem hộ em

Public Sub laydulieu()
Dim filedlg As FileDialog
Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
Dim mypath As String
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path
With filedlg
.InitialFileName = mypath
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel", "*.xls?"
If .Show = True Then
Dim lastRow As Long
Dim wb_active As Workbook
Dim ws_active As Worksheet
Dim wb_close As Workbook
Dim ws_close As Worksheet
Set wb_active = ThisWorkbook
Set wb_close = Workbooks.Open(mypath, True, True)
Set ws_close = wb_close.Sheet1
Set ws_active = wb_active.Sheet3
Set lastrow = ws_close.Range("A" & Rows.Count).End(xlUp).Row + 1
ws_close.Range("A1:K" & lastrow).copy Destination:=ws_active.Range("A1")
End If
End With
Set filedlg = Nothing
wb_close.Close
End Sub

vanthinh3101 · 19/11/22

bjboyn00b đã viết:
Cảm ơn bác, em đang sử dụng code sau, em thấy báo sai khi đặt biến lastrow, em xem lại không hiểu sai ở đâu, có gì bác xem hộ em

Lỗi sai hiện lên như thế nào bạn, chụp lên cho mọi người xem.
Code có đoạn này:

Mã:

Application.ScreenUpdating = False

Vậy còn đoạn này nữa đâu:

Mã:

Application.ScreenUpdating = True

Thêm nữa, bạn chỉ cần lấy dữ liệu từ 1 file hay nhiều file, code bạn đang dùng chỉ lấy được dữ liệu từ 1 file/1 lần.

bjboyn00b · 19/11/22

vanthinh3101 đã viết:
Lỗi sai hiện lên như thế nào bạn, chụp lên cho mọi người xem.
Code có đoạn này:

Mã:

Application.ScreenUpdating = False

Vậy còn đoạn này nữa đâu:

Mã:

Application.ScreenUpdating = True

Thêm nữa, bạn chỉ cần lấy dữ liệu từ 1 file hay nhiều file, code bạn đang dùng chỉ lấy được dữ liệu từ 1 file/1 lần.

Mình chỉ lấy dữ liệu ở 1 file bạn ạ. Mình bỏ đoạn đó để đặt code mới như sau, mình đang không đặt biến là file mở như nào , nó đang bị lẫn nhận dạng của 2 file

, xem giúp mình nhé

Sub laydulieu()
Dim filedlg As FileDialog
Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
Dim mypath As String
Dim wb_old As Workbook
Dim ws_old As Worksheet
Set wb_old = ThisWorkbook
Set ws_old = wb_old.Sheets("Data")
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path
With filedlg
.InitialFileName = mypath
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel", "*.xls?"
If .Show = True Then
Dim wb_new As Workbook
Dim ws_new As Worksheet
Set wb_new = ActiveWorkbook
Set ws_new = wb_new.Sheets(1)
ws_new.Range("A1:K10000").copy
ws_old.Range("A1").PasteSpecial Paste:=xlPasteValues

End If
End With
Set filedlg = Nothing
wb_new.Close
End Sub

Hoàng Tuấn 868 · 19/11/22

bjboyn00b đã viết:
Mình chỉ lấy dữ liệu ở 1 file bạn ạ. Mình bỏ đoạn đó để đặt code mới như sau, mình đang không đặt biến là file mở như nào , nó đang bị lẫn nhận dạng của 2 file , xem giúp mình nhé

Sub laydulieu()
Dim filedlg As FileDialog
Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
Dim mypath As String
Dim wb_old As Workbook
Dim ws_old As Worksheet
Set wb_old = ThisWorkbook
Set ws_old = wb_old.Sheets("Data")
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path
With filedlg
.InitialFileName = mypath
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel", "*.xls?"
If .Show = True Then
Dim wb_new As Workbook
Dim ws_new As Worksheet
Set wb_new = ActiveWorkbook
Set ws_new = wb_new.Sheets(1)
ws_new.Range("A1:K10000").copy
ws_old.Range("A1").PasteSpecial Paste:=xlPasteValues

End If
End With
Set filedlg = Nothing
wb_new.Close
End Sub

Chưa đề cập đến nội dung, nhưng có vẻ như vẫn thiếu dòng này: "Application.ScreenUpdating = True"

vanthinh3101 · 19/11/22

bjboyn00b đã viết:
Mình chỉ lấy dữ liệu ở 1 file bạn ạ. Mình bỏ đoạn đó để đặt code mới như sau, mình đang không đặt biến là file mở như nào , nó đang bị lẫn nhận dạng của 2 file , xem giúp mình nhé

Sub laydulieu()
Dim filedlg As FileDialog
Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
Dim mypath As String
Dim wb_old As Workbook
Dim ws_old As Worksheet
Set wb_old = ThisWorkbook
Set ws_old = wb_old.Sheets("Data")
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path
With filedlg
.InitialFileName = mypath
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel", "*.xls?"
If .Show = True Then
Dim wb_new As Workbook
Dim ws_new As Worksheet
Set wb_new = ActiveWorkbook
Set ws_new = wb_new.Sheets(1)
ws_new.Range("A1:K10000").copy
ws_old.Range("A1").PasteSpecial Paste:=xlPasteValues

End If
End With
Set filedlg = Nothing
wb_new.Close
End Sub

Code thì bạn phải đưa vào phần code cho nó dễ nhìn.
Tôi không chắc là đã đúng, nhưng bạn thử xem sao.
Code của bạn chưa có thủ tục mở file chọn nên bị vậy.

Mã:

Sub laydulieu()
    Dim filedlg As FileDialog
    Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
    Dim mypath As String
    Dim wb_old As Workbook
    Dim ws_old As Worksheet
    Set wb_old = ThisWorkbook
    Set ws_old = wb_old.Sheets("Data")
   
    Application.ScreenUpdating = False
    mypath = ThisWorkbook.Path
    With filedlg
        .InitialFileName = mypath
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel", "*.xls?"
        If .Show = True Then
            Dim wb_new As Workbook
            Dim ws_new As Worksheet
            Set wb_new = workbooks.open(filedlg.selecteditems(1))
            Set ws_new = wb_new.worksheets(1)
            ws_new.Range("A1:K10000").copy
            ws_old.Range("A1").PasteSpecial Paste:=xlPasteValues
            wb_new.Close
        End If
    End With
    Set filedlg = Nothing
   
    Application.ScreenUpdating = True
End Sub

bjboyn00b · 19/11/22

vanthinh3101 đã viết:

Code thì bạn phải đưa vào phần code cho nó dễ nhìn.
Tôi không chắc là đã đúng, nhưng bạn thử xem sao.
Code của bạn chưa có thủ tục mở file chọn nên bị vậy.

Mã:

Sub laydulieu()
    Dim filedlg As FileDialog
    Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
    Dim mypath As String
    Dim wb_old As Workbook
    Dim ws_old As Worksheet
    Set wb_old = ThisWorkbook
    Set ws_old = wb_old.Sheets("Data")
  
    Application.ScreenUpdating = False
    mypath = ThisWorkbook.Path
    With filedlg
        .InitialFileName = mypath
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel", "*.xls?"
        If .Show = True Then
            Dim wb_new As Workbook
            Dim ws_new As Worksheet
            Set wb_new = workbooks.open(filedlg.selecteditems(1))
            Set ws_new = wb_new.worksheets(1)
            ws_new.Range("A1:K10000").copy
            ws_old.Range("A1").PasteSpecial Paste:=xlPasteValues
            wb_new.Close
        End If
    End With
    Set filedlg = Nothing
  
    Application.ScreenUpdating = True
End Sub

Cảm ơn bạn, cảm ơn mọi người nhiều, file chạy trơn chu rồi

.
Mình mới tìm hiểu về VBA nên nhiều cái không rõ, khi làm thủ tục mở file chọn thì ý nghĩa của slecteditem(1) là như nào nhỉ, (1) ở đây có nghĩa là gì vậy bạn?

Hoàng Tuấn 868 · 19/11/22

bjboyn00b đã viết:
Cảm ơn bạn, cảm ơn mọi người nhiều, file chạy trơn chu rồi .
Mình mới tìm hiểu về VBA nên nhiều cái không rõ, khi làm thủ tục mở file chọn thì ý nghĩa của slecteditem(1) là như nào nhỉ, (1) ở đây có nghĩa là gì vậy bạn?

Chỉ có chép lại cũng sai, bạn này còn vất vả đây. (Bạn gõ tìm kiếm ra ngay mà).

bjboyn00b · 19/11/22

Hoàng Tuấn 868 đã viết:
Chỉ có chép lại cũng sai, bạn này còn vất vả đây. (Bạn gõ tìm kiếm ra ngay mà).

Hihi, mình hỏi thêm, mình đặt lastrow cho nhẹ bộ nhớ, tuy nhiên nó báo lỗi như dưới, code này mình đặt nhiều rồi không nghĩ là sai, xem hộ mình với nhé.

huhumalu · 19/11/22

PHP:

lastrow = ws_new.Range("A" & Rows.Count).End(xlUp).Row + 1

Sao lại cứ phải set bạn nhỉ ? (Lỗi yêu cầu đối tượng được gán phải là "Object" )
Khi bạn gán giá trị chứ không phải là đối tượng thì không dùng Set.

bjboyn00b · 19/11/22

huhumalu đã viết:
PHP:

lastrow = ws_new.Range("A" & Rows.Count).End(xlUp).Row + 1

Sao lại cứ phải set bạn nhỉ ? (Lỗi yêu cầu đối tượng được gán phải là "Object" )
Khi bạn gán giá trị chứ không phải là đối tượng thì không dùng Set.

Cảm ơn bạn nhiều nhé

Xin hướng dẫn code động lấy dữ liệu từ 1 file đang đóng

bjboyn00b

Thành viên chính thức

huhumalu

Thành viên tích cực

Copy dữ liệu từ file đang đóng

snow25

Thành viên gạo cội

hvnhpro

Thành viên hoạt động

bjboyn00b

Thành viên chính thức

vanthinh3101

Thành viên tích cực

bjboyn00b

Thành viên chính thức

Hoàng Tuấn 868

Đăng ký hôm qua

vanthinh3101

Thành viên tích cực

bjboyn00b

Thành viên chính thức

Hoàng Tuấn 868

Đăng ký hôm qua

bjboyn00b

Thành viên chính thức

huhumalu

Thành viên tích cực

bjboyn00b

Thành viên chính thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng