Sub importData_test()
Dim owb As Workbook
Dim sh As Worksheet
Set sh = Sheet1
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
'copy vùng dữ liệu cần lấy
owb.Sheets("Data").Range("C1:G200").Copy
'dán vào vũng cần lấy kết quá
sh.Range("A1").PasteSpecial xlPasteAll
owb.Close False
End Sub
Trong trường hợp này thì sheet cần lấy dữ liệu phải có tên là "Data"
nhưng mình muốn nhờ mọi người giúp trong trường hợp Sheets"Data" là 1 cái tên bất kỳ mà vẫn lấy được dữ liệu
mong mọi người giúp ạ.
Sub importData_test(ten_bat_ky as string)
Dim owb As Workbook
Dim sh As Worksheet
Set sh = Sheet1
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
'copy vùng dữ liệu cần lấy
owb.Sheets(ten_bat_ky).Range("C1:G200").Copy
'dán vào vũng cần lấy kết quá
sh.Range("A1").PasteSpecial xlPasteAll
owb.Close False
End Sub
muốn nhập sheet nào thì gọi sub này ra, ví dụ sheet tên là Du_lieu thì
Sub importData_test(ten_bat_ky as string)
Dim owb As Workbook
Dim sh As Worksheet
Set sh = Sheet1
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
'copy vùng dữ liệu cần lấy
owb.Sheets(ten_bat_ky).Range("C1:G200").Copy
'dán vào vũng cần lấy kết quá
sh.Range("A1").PasteSpecial xlPasteAll
owb.Close False
End Sub
muốn nhập sheet nào thì gọi sub này ra, ví dụ sheet tên là Du_lieu thì
Bạn yêu cầu là tên bất kỳ(.name) thì mình mới gợi ý code như vậy, còn cái bạn nói về số là vị trí của sheet trong workbook rồi (.index). Tùy vào bảng tính của bạn như thế nào thì bạn lựa chọn nên sử dụng thuộc tính name hay index, nếu bạn muốn sử dụng index thì mình nghỉ thay đổi vầy thôi.
Mã:
Sub importData_test(vi_tri as integer)
Dim owb As Workbook
Dim sh As Worksheet
Set sh = Sheet1
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
'copy vùng dữ liệu cần lấy
owb.Sheets(vi_tri).Range("C1:G200").Copy
'dán vào vũng cần lấy kết quá
sh.Range("A1").PasteSpecial xlPasteAll
owb.Close False
End Sub
Sau đó muốn lấy dữ liệu sheet số mấy thì gọi thủ tục này ra,ví dụ sheet số 5 trong workbook
Bạn yêu cầu là tên bất kỳ(.name) thì mình mới gợi ý code như vậy, còn cái bạn nói về số là vị trí của sheet trong workbook rồi (.index). Tùy vào bảng tính của bạn như thế nào thì bạn lựa chọn nên sử dụng thuộc tính name hay index, nếu bạn muốn sử dụng index thì mình nghỉ thay đổi vầy thôi.
Mã:
Sub importData_test(vi_tri as integer)
Dim owb As Workbook
Dim sh As Worksheet
Set sh = Sheet1
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
'copy vùng dữ liệu cần lấy
owb.Sheets(vi_tri).Range("C1:G200").Copy
'dán vào vũng cần lấy kết quá
sh.Range("A1").PasteSpecial xlPasteAll
owb.Close False
End Sub
Sau đó muốn lấy dữ liệu sheet số mấy thì gọi thủ tục này ra,ví dụ sheet số 5 trong workbook
Mình làm được rồi nhưng dữ liệu của mình khoảng 20.000 dòng x 12 cột, sau khi mở file nguồn ra, khi nó đóng lại thì nó thông báo theo hình dưới. Có cách nào tắt nó luôn không vậy?
Và có thể thay đổi vị trí sheet (ví dụ: 1 , 2, 3...) thành tên worksheet không?
Mình gởi 2 file lên nhờ bạn xem dùm nhé.
Ngoài ra, đê thuận tiện cho việc sao chép file này ra nhiều file khác nhau, mình có ý là đường link và tên sheet có thể đặt trong file đích tại ô B1 và B2, code sẽ lấy theo 2 ô này. Vì nếu copy file này ra vị trí khác thì phải vào code để chỉnh sửa thì sẽ khó khăn cho người khác. Họ cứ chèn link và tên sheet vào 2 vị trí trên là được.
Xin chào anh79_ct
Trước hết bạn hãy bỏ các dấu " tại ô B1 và B2 đi nhé:
Ví dụ:
"qryexpPartsList" thì sửa thành: qryexpPartsList
Vì khi đã khai báo: ten_bat_ky As String như vậy có nghĩa tên sheet là dạng chuỗi (String)
Tương tự bạn hãy bỏ 2 dấu "" trong ô B1, code bạn Oanh Thơ sửa lại như sau:
Mã:
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet
Dim tenfile As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
'mở file cần lấy dữ liệu
Set owb = Workbooks.Open(tenfile)
'copy vùng dữ liệu cần lấy
owb.Sheets(ten_bat_ky).Range("A1:L20000").Copy
'dán vào vùng cần lấy kết quả
sh.Range("A3").PasteSpecial xlPasteAll
Application.CutCopyMode = False
owb.Close False
End Sub
Sub Button2_Click()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
Hình như cái này là mở file lên, lấy dữ liệu rồi đóng file thì phải? Chứ không phải như ADO là lấy dữ liệu không mở file.
Vậy trường hợp file này đang bị user khác mở rồi thì code này có chạy được ko?
Hình như cái này là mở file lên, lấy dữ liệu rồi đóng file thì phải? Chứ không phải như ADO là lấy dữ liệu không mở file.
Vậy trường hợp file này đang bị user khác mở rồi thì code này có chạy được ko?
Xin chào babyheomoi,
Nếu trường hợp mở file rồi thì thêm hàm kiểm tra xem file đã mở hay chưa nếu chưa mở thì mở file còn nếu mở rồi thì không mở nữa, code sẽ sửa lại như sau:
Mã:
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet
Dim tenfile As String, source_FileName As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
If bIsBookOpen(source_FileName) Then
Set owb = Workbooks(source_FileName)
Else
Set owb = Workbooks.Open(tenfile)
End If
owb.Sheets(ten_bat_ky).Range("A1:L20000").Copy
sh.Range("A3").PasteSpecial
Application.CutCopyMode = False
' owb.Close False
End Sub
Sub Button2_Click()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
OanhThơ chưa thử trong trường hợp tập tin để trong thư mục sharefull , khi các user khác mở nên thì sẽ thế nào.Nếu bạn có điều kiện nhờ bạn test giúp.
Hình như cái này là mở file lên, lấy dữ liệu rồi đóng file thì phải? Chứ không phải như ADO là lấy dữ liệu không mở file.
Vậy trường hợp file này đang bị user khác mở rồi thì code này có chạy được ko?
Cám ơn các bạn rất nhiều, nếu thêm 1 yêu cầu nữa là khi mở file lên, nó tự động lấy luôn dữ liệu ở file đang đóng luôn được không? Không cần tạo nút lệnh.
Cám ơn các bạn rất nhiều, nếu thêm 1 yêu cầu nữa là khi mở file lên, nó tự động lấy luôn dữ liệu ở file đang đóng luôn được không? Không cần tạo nút lệnh.
Xin chào babyheomoi,
Nếu trường hợp mở file rồi thì thêm hàm kiểm tra xem file đã mở hay chưa nếu chưa mở thì mở file còn nếu mở rồi thì không mở nữa, code sẽ sửa lại như sau:
Mã:
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet
Dim tenfile As String, source_FileName As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
If bIsBookOpen(source_FileName) Then
Set owb = Workbooks(source_FileName)
Else
Set owb = Workbooks.Open(tenfile)
End If
owb.Sheets(ten_bat_ky).Range("A1:L20000").Copy
sh.Range("A3").PasteSpecial
Application.CutCopyMode = False
' owb.Close False
End Sub
Sub Button2_Click()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
OanhThơ chưa thử trong trường hợp tập tin để trong thư mục sharefull , khi các user khác mở nên thì sẽ thế nào.Nếu bạn có điều kiện nhờ bạn test giúp.
Vậy xin cho em hỏi: em muốn copy dữ liệu dòng cuối cùng của file nguồn Sheet1 vào dòng cuối cùng của file đích Sheet A thì điều chỉnh code như thế nào ạ?
Vậy xin cho em hỏi: em muốn copy dữ liệu dòng cuối cùng của file nguồn Sheet1 vào dòng cuối cùng của file đích Sheet A thì điều chỉnh code như thế nào ạ?
Vậy xin cho em hỏi: em muốn copy dữ liệu dòng cuối cùng của file nguồn Sheet1 vào dòng cuối cùng của file đích Sheet A thì điều chỉnh code như thế nào ạ?
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet, shSoure As Worksheet, lR As Long
Dim tenfile As String, source_FileName As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
If bIsBookOpen(source_FileName) Then
Set owb = Workbooks(source_FileName)
Else
Set owb = Workbooks.Open(tenfile)
End If
Set shSoure = owb.Sheets(ten_bat_ky)
lR = LastRow(shSoure, "A")
shSoure.Rows(lR & ":" & lR).Copy
lR = LastRow(sh, "A") + 1: sh.Rows(lR & ":" & lR).PasteSpecial
Application.CutCopyMode = False
' owb.Close False
End Sub
Sub Button2_Click()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function LastRow(sh As Worksheet, nameCol As String) As Long
LastRow = sh.Cells(sh.Rows.Count, nameCol).End(xlUp).Row
End Function
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet, shSoure As Worksheet, lR As Long
Dim tenfile As String, source_FileName As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
If bIsBookOpen(source_FileName) Then
Set owb = Workbooks(source_FileName)
Else
Set owb = Workbooks.Open(tenfile)
End If
Set shSoure = owb.Sheets(ten_bat_ky)
lR = LastRow(shSoure, "A")
shSoure.Rows(lR & ":" & lR).Copy
lR = LastRow(sh, "A") + 1: sh.Rows(lR & ":" & lR).PasteSpecial
Application.CutCopyMode = False
' owb.Close False
End Sub
Sub Button2_Click()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function LastRow(sh As Worksheet, nameCol As String) As Long
LastRow = sh.Cells(sh.Rows.Count, nameCol).End(xlUp).Row
End Function
Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ
Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ
Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ
Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
Xin chào chuotpt3
Không chạy được là vì bạn không gửi file kèm và hỏi chung chung nên Oanh Thơ bạn đang sử dụng file kèm của chủ tài.
Cũng giống với thắc mắc mà bạn @tam888 hỏi, Oanh Thơ cũng không biết:
các dòng đỏ đó, chưa được cập nhật, là căn cứ vào cái gì để nhận biết?
Sub LayDuLieu()
Dim ThisWS As Worksheet, ThisRng As Range
Dim sourceWB As Workbook, sourceWS As Worksheet, sourceRng As Range
Dim lCol As Long, sFolder As String, lr As Long, sFile As Variant
Const source_SheetName As String = "Checked Data"
Const target_SheetName As String = "Develop-for-SC"
sFile = Application.GetOpenFilename(("Excel File, *.xls*"), , "Select your File")
If sFile = False Then Exit Sub
isOpen (GetFilenameFromPath(sFile))
Set sourceWB = Application.Workbooks(GetFilenameFromPath(sFile))
Set sourceWS = sourceWB.Worksheets(source_SheetName)
Set sourceRng = sourceWS.Rows(14 & ":" & 26)
Set ThisWS = ThisWorkbook.Worksheets(target_SheetName)
lr = ThisWS.Cells(ThisWS.Rows.Count, "A").End(xlUp).Row
Set ThisRng = ThisWS.Rows(lr + 1)
sourceRng.Copy: ThisRng.PasteSpecial , , False, False
Application.CutCopyMode = False
'sourceWB.Close False
End Sub
Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Function isOpen(ByVal strPath As String)
Dim wBook As Workbook
On Error Resume Next
Set wBook = Workbooks(strPath)
If wBook Is Nothing Then 'Not open
Application.Workbooks.Open (strPath)
End If
End Function
Dạ chạy thì đúng như ghi nhận bên trên rồi ạ – Em/Mình xin cảm ơn lắm lắm.
Nhưng trường hợp mình sẽ phải đọc từ nhiều file có cấu trúc tương tự (S1, S2, S,...) – đọc theo cell của cột E = Phase Name" và sẽ đọc từ cột F trở đi (là các cột có màu xám tro đó ạ – các cột không có màu xám tro sẽ key tay vào) – và các file đọc sau sẽ record theo các dòng kế tiếp/tiếp tục. Anh/Bạn giúp mình được không ạ?
Mong tin Anh/Bạn lắm
Em/Mình xin cảm ơn Anh/Bạn nhiều ơi là nhiều ạ
Dạ chạy thì đúng như ghi nhận bên trên rồi ạ – Em/Mình xin cảm ơn lắm lắm.
Nhưng trường hợp mình sẽ phải đọc từ nhiều file có cấu trúc tương tự (S1, S2, S,...) – đọc theo cell của cột E = Phase Name" và sẽ đọc từ cột F trở đi (là các cột có màu xám tro đó ạ – các cột không có màu xám tro sẽ key tay vào) – và các file đọc sau sẽ record theo các dòng kế tiếp/tiếp tục. Anh/Bạn giúp mình được không ạ?
Mong tin Anh/Bạn lắm
Em/Mình xin cảm ơn Anh/Bạn nhiều ơi là nhiều ạ
Bạn thử chạy code sau xem có đúng ý không ạ, bạn chú ý cho tất cả các file source có cấu trúc giống nhau vào cùng thư mục với file target nhé:
Mã:
Sub LayDuLieu_2()
Dim WB As Workbook, Fso As Object, FileItem As Object, MainWB As Workbook, sh As Worksheet
Const source_SheetName As String = "Checked Data": Const target_SheetName As String = "Develop-for-SC"
Set MainWB = ThisWorkbook: Set Fso = CreateObject("Scripting.FileSystemObject")
For Each FileItem In Fso.GetFolder(ThisWorkbook.Path).Files
If FileItem.Name <> ThisWorkbook.Name And Left(FileItem.Name, 1) <> "~" Then
Set WB = Workbooks.Open(FileItem.Path): Set sh = MainWB.Worksheets(target_SheetName)
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
WB.Close False
End If
Next FileItem
Set FileItem = Nothing: Set Fso = Nothing
End Sub
Dạ chạy thì nó báo lỗi ở câu lệnh này:
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
Như sau:
Và ra 1 file add data ngộ nghĩnh lắm lắm ạ:
Dạ chạy thì nó báo lỗi ở câu lệnh này:
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
Như sau: View attachment 208598
Và ra 1 file add data ngộ nghĩnh lắm lắm ạ: View attachment 208601
Trời ơi, bạn ngóng Oanh Thơ (OT) để làm gì... kiến thức Excel của OT chắc gì đã hơn bạn chứ bạn làm OT ngại quá hihi
OT cũng đang ngóng các bạn khác vào hỗ trợ cho bạn đây, OT đang cảm thấy đuối dần đều rồi nè T_T
Bạn giải nén rồi chạy thử nhé:
Dạ, mình lại "đòi xôi gấc ạ" nghĩa là click Button "Upload data" và cho chọn file để upload các dòng này được không ạ? file mới nhất sẽ upload vào các dòng kế tiếp các dòng này – được không ạ?
Vì có thể:
– File S1 sẽ được bạn A upload vào ngày X
– File S2 sẽ được bạn E upload vào ngày Z
– File S3 sẽ được bạn G upload vào ngày W
– File S4 sẽ được bạn R upload vào ngày D
.......
Dạ, mình lại "đòi xôi gấc ạ" nghĩa là click Button "Upload data" và cho chọn file để upload các dòng này được không ạ? file mới nhất sẽ upload vào các dòng kế tiếp các dòng này – được không ạ?
Vì có thể:
– File S1 sẽ được bạn A upload vào ngày X
– File S2 sẽ được bạn E upload vào ngày Z
– File S3 sẽ được bạn G upload vào ngày W
– File S4 sẽ được bạn R upload vào ngày D
.......
Dạ, File tổng là file Target_Insert-Row-Below đấy ạ
Mở file này lên – rồi click Button trong file sẽ cho chọn file – mình có thể upload dữ liệu từng file – chứ không upload toàn bộ các file một lần mà không cho chọn được ạ
Dạ, File tổng là file Target_Insert-Row-Below đấy ạ
Mở file này lên – rồi click Button trong file sẽ cho chọn file – mình có thể upload dữ liệu từng file – chứ không upload toàn bộ các file một lần mà không cho chọn được ạ
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": Exit Sub
For Each k In .SelectedItems
Set wb = Workbooks.Open(k)
b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
arr = wb.Sheets(1).Range("a2:q" & b).Value
wb.Close False
a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Erase arr
Next
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Vậy có cách nào không anh.Hay là trước khi Exit Sub.Thì mở lại nó có được không nhỉ.
Mã:
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
If Not .Show = -1 Then
MsgBox ("khong chon file nao"), vbCritical, "KK"
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Exit Sub
End If
For Each k In .SelectedItems
Set wb = Workbooks.Open(k)
b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
arr = wb.Sheets(1).Range("a2:q" & b).Value
wb.Close False
a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Erase arr
Next
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Option Explicit
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": GoTo Thoat
For Each k In .SelectedItems
Set wb = Workbooks.Open(k)
b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
arr = wb.Sheets(1).Range("a2:q" & b).Value
wb.Close False
a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Erase arr
Next
End With
Debug.Print "OK da cap nhat"
Thoat:
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Debug.Print "Thoat vi khong chon file"
End Sub
Option Explicit
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": GoTo Thoat
For Each k In .SelectedItems
Set wb = Workbooks.Open(k)
b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
arr = wb.Sheets(1).Range("a2:q" & b).Value
wb.Close False
a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Erase arr
Next
End With
Debug.Print "OK da cap nhat"
Thoat:
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Debug.Print "Thoat vi khong chon file"
End Sub
Bạn thử chạy code sau xem có đúng ý không ạ, bạn chú ý cho tất cả các file source có cấu trúc giống nhau vào cùng thư mục với file target nhé:
Mã:
Sub LayDuLieu_2()
Dim WB As Workbook, Fso As Object, FileItem As Object, MainWB As Workbook, sh As Worksheet
Const source_SheetName As String = "Checked Data": Const target_SheetName As String = "Develop-for-SC"
Set MainWB = ThisWorkbook: Set Fso = CreateObject("Scripting.FileSystemObject")
For Each FileItem In Fso.GetFolder(ThisWorkbook.Path).Files
If FileItem.Name <> ThisWorkbook.Name And Left(FileItem.Name, 1) <> "~" Then
Set WB = Workbooks.Open(FileItem.Path): Set sh = MainWB.Worksheets(target_SheetName)
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
WB.Close False
End If
Next FileItem
Set FileItem = Nothing: Set Fso = Nothing
End Sub
--> @Nguyễn Hoàng Oanh Thơ
Wow trong topic này thấy OT code nhiều đấy.
Vì chỉ đọc các dữ liệu nên:
Mã:
Set WB = Workbooks.Open(FileItem.Path, True, True)
Để chỉ đọc và không mở Workbook
Tìm một hướng khác thay cho Copy
Và OT nên liệt kê các Path của file cần lấy dữ liệu vào 1 sheet.
dùng Event Selection để chọn Path / All Path rồi lấy dữ liệu. Để đạt yêu cầu dưới
Dạ, mình lại "đòi xôi gấc ạ" nghĩa là click Button "Upload data" và cho chọn file để upload các dòng này được không ạ? file mới nhất sẽ upload vào các dòng kế tiếp các dòng này – được không ạ?
.......
--> @chuotpt3
Sau khi đã thực hiện lấy dữ liệu xong tôi nghĩ bạn cần có 1 sheet lưu lại lịch sử. Để nhở mà dữ liệu đến vài ngàn, chục ngàn. thì còn biết file đó ai làm, ai upload
Nếu bạn muốn excel tự động chạy tìm duyệt Nếu có file mới thì tự động get vào thì dùng:
Mã:
'Code Events cho Sheet2'
'Chọn ô A1 để tự động On / Off'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([A1], Target) Is Nothing And Not IsArray(Selection) Then
If LCase([A1]) = "off" Then
[A1] = "on"
StartFind_1
Else
[A1] = "off"
End If
End If
End Sub
'Code Module'
Sub StartFind_1()
If Sheet2.[A1].value = "off" Then StopTimer: Exit Sub
'Code / Sub tìm file mới ở đây
StartFind_2
End Sub
Sub StartFind_2()
'Thay đổi' thời gian mỗi lần duyệt TimeValue("00:00:01")
Application.OnTime Now + TimeValue("00:00:01"), "StartFind_1"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="StartFind_1", Schedule:=False
End Sub
--> @Nguyễn Hoàng Oanh Thơ
Wow trong topic này thấy OT code nhiều đấy.
Vì chỉ đọc các dữ liệu nên:
Mã:
Set WB = Workbooks.Open(FileItem.Path, True, True)
Để chỉ đọc và không mở Workbook
Tìm một hướng khác thay cho Copy
Và OT nên liệt kê các Path của file cần lấy dữ liệu vào 1 sheet.
dùng Event Selection để chọn Path / All Path rồi lấy dữ liệu. Để đạt yêu cầu dưới
--> @chuotpt3
Sau khi đã thực hiện lấy dữ liệu xong tôi nghĩ bạn cần có 1 sheet lưu lại lịch sử. Để nhở mà dữ liệu đến vài ngàn, chục ngàn. thì còn biết file đó ai làm, ai upload
Nếu bạn muốn excel tự động chạy tìm duyệt Nếu có file mới thì tự động get vào thì dùng:
Mã:
'Code Events cho Sheet2'
'Chọn ô A1 để tự động On / Off'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([A1], Target) Is Nothing And Not IsArray(Selection) Then
If LCase([A1]) = "off" Then
[A1] = "on"
StartFind_1
Else
[A1] = "off"
End If
End If
End Sub
'Code Module'
Sub StartFind_1()
If Sheet2.[A1].value = "off" Then StopTimer: Exit Sub
'Code / Sub tìm file mới ở đây
StartFind_2
End Sub
Sub StartFind_2()
'Thay đổi' thời gian mỗi lần duyệt TimeValue("00:00:01")
Application.OnTime Now + TimeValue("00:00:01"), "StartFind_1"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="StartFind_1", Schedule:=False
End Sub
Chỉ là OT copy code của các anh chị trên đây rồi sửa sửa thôi ạ
Nhiều code nhưng chưa có đoạn nào vừa ý @chuotpt3 cả hihi
Cảm ơn các đoạn code trên của bạn, hiện OT chưa hiểu những đoạn code đó, nhưng OT sẽ cố gắng dành thời gian để tìm hiểu.
Một lần nữa cảm ơn minahnh0011 đã quan tâm.
Ôi....mình cảm ơn cả nhà nhiều ơi là nhiều ạ........Đúng ý luôn ạ
==========
Vì chỗ này đang có topic nên mình post vào đây – mình có post một trường hợp nữa kính nhờ các bạn giúp đỡ với ạ – mình post ở đây
--> @Nguyễn Hoàng Oanh Thơ
Wow trong topic này thấy OT code nhiều đấy.
Vì chỉ đọc các dữ liệu nên:
Mã:
Set WB = Workbooks.Open(FileItem.Path, True, True)
Để chỉ đọc và không mở Workbook
Tìm một hướng khác thay cho Copy
Và OT nên liệt kê các Path của file cần lấy dữ liệu vào 1 sheet.
dùng Event Selection để chọn Path / All Path rồi lấy dữ liệu. Để đạt yêu cầu dưới
--> @chuotpt3
Sau khi đã thực hiện lấy dữ liệu xong tôi nghĩ bạn cần có 1 sheet lưu lại lịch sử. Để nhở mà dữ liệu đến vài ngàn, chục ngàn. thì còn biết file đó ai làm, ai upload
Nếu bạn muốn excel tự động chạy tìm duyệt Nếu có file mới thì tự động get vào thì dùng:
Mã:
'Code Events cho Sheet2'
'Chọn ô A1 để tự động On / Off'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([A1], Target) Is Nothing And Not IsArray(Selection) Then
If LCase([A1]) = "off" Then
[A1] = "on"
StartFind_1
Else
[A1] = "off"
End If
End If
End Sub
'Code Module'
Sub StartFind_1()
If Sheet2.[A1].value = "off" Then StopTimer: Exit Sub
'Code / Sub tìm file mới ở đây
StartFind_2
End Sub
Sub StartFind_2()
'Thay đổi' thời gian mỗi lần duyệt TimeValue("00:00:01")
Application.OnTime Now + TimeValue("00:00:01"), "StartFind_1"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="StartFind_1", Schedule:=False
End Sub
Trong post nào đó em có ghi nhận là trường hợp mình copy dòng cuối cùng của từng File source vào File Target được không ạ?
Vì khi đó file Target đã có hòm hòm dữ liệu rồi ạ
Mình có 1 file tổng và 1 file con, Không biết làm cách nào đề chuyển dữ liệu từ sheet của file con vào sheet của file tổng. Minh có áp dụng code trên nhưng khi chạyma61a61t luôn tiêu đề của các cot và dữ liệu cũng không gọp được. Rất mong được sự giúp đỡ của các anh chị.
Bạn ơi, ví dụ file nguồn đang mở, khi mở file đích thì nó tự đóng file nguồn luôn, như vậy lại ảnh hưởng đến người khác đang mở file nguồn. Vậy có cách nào nó chỉ lấy dữ liệu (lưu cuối cùng) bất kể file nguồn đang mở hay đóng không?
Bạn ơi, ví dụ file nguồn đang mở, khi mở file đích thì nó tự đóng file nguồn luôn, như vậy lại ảnh hưởng đến người khác đang mở file nguồn. Vậy có cách nào nó chỉ lấy dữ liệu (lưu cuối cùng) bất kể file nguồn đang mở hay đóng không?
Bạn ơi, ví dụ file nguồn đang mở, khi mở file đích thì nó tự đóng file nguồn luôn, như vậy lại ảnh hưởng đến người khác đang mở file nguồn. Vậy có cách nào nó chỉ lấy dữ liệu (lưu cuối cùng) bất kể file nguồn đang mở hay đóng không?
Khi mở tập tin ở chế độ share full nếu có người đang mở thì người mở sau chỉ là chế độ readonly thôi chứ làm sao mà ảnh hưởng đến người khác đang mở file nguồn được nhỉ.
Bạn kiểm tra lại xem sao ạ.
@Nguyễn Hoàng Oanh Thơ
OT có thể giải thích cho tôi được hiểu tí về các cách gọi, vì tôi chậm hiểu thuật ngữ lắm:
1. File nguồn
2. File Đích
3. share full
bạn anh79_ct hỏi gì mà đích đích nguồn nguồn. Vậy mà OT hiểu.
@Nguyễn Hoàng Oanh Thơ
OT có thể giải thích cho tôi được hiểu tí về các cách gọi, vì tôi chậm hiểu thuật ngữ lắm:
1. File nguồn
2. File Đích
3. share full
bạn anh79_ct hỏi gì mà đích đích nguồn nguồn. Vậy mà OT hiểu.
Hỏi thật. Anh VIệt gì đâu. Không hiểu các thuật ngữ đấy. Thấy OT đọc hiểu nên hỏi. File nguồn là file như thế nào. File gì gọi là file đích
Hiểu mới trả lời bạn ấy được chứ
Hỏi thật. Anh VIệt gì đâu. Không hiểu các thuật ngữ đấy. Thấy OT đọc hiểu nên hỏi. File nguồn là file như thế nào. File gì gọi là file đích
Hiểu mới trả lời bạn ấy được chứ
OT đã tham gia từ đầu chủ đề này nên cũng hiểu máy móc như sau ạ:
File nguồn là file chứa dữ liệu nguồn cần đưa sang một file khác, file khác này gọi là file đích.
Trong chủ đề cũng có bạn gọi là file soure hay file target v. v..
Còn OT hiểu share full: là vì bài 46 bạn ấy mô tả khi mở file đích lên code sẽ tự động lấy dữ liệu ở file nguồn (có trích dẫn code) rồi code tự động đóng file nguồn nên sợ sẽ ảnh hưởng đến người nào đó đang mở.
...
Không biết hiểu như vậy có đúng ý bạn hỏi không ạ
OT đã tham gia từ đầu chủ đề này nên cũng hiểu máy móc như sau ạ:
File nguồn là file chứa dữ liệu nguồn cần đưa sang một file khác, file khác này gọi là file đích.
Trong chủ đề cũng có bạn gọi là file soure hay file target v. v..
Còn OT hiểu share full: là vì bài 46 bạn ấy mô tả khi mở file đích lên code sẽ tự động lấy dữ liệu ở file nguồn (có trích dẫn code) rồi code tự động đóng file nguồn nên sợ sẽ ảnh hưởng đến người nào đó đang mở.
...
Không biết hiểu như vậy có đúng ý bạn hỏi không ạ
@Nguyễn Hoàng Anh Thơ
Ý mình hỏi đúng như bạn nghĩ. Mình giải thích rõ hơn chút.
File đích: là file cần chép dữ liệu đến, và viết code trên file này.
File nguồn: theo như chủ đề ở đây là file đang đóng, cần lấy dữ liệu từ file này. File này mình xuất dữ liệu ra từ phần mềm khác và cập nhập (update) chép đè lên file này hàng tuần nên không thể share full được. Thông thường thì cũng ít khi phải mở ra nhưng vì lúc chạy thử code mình thấy xuất hiện sự việc là nếu đang mở thì nó sẽ bị đóng lại khi mở file đích nên mình có suy nghĩ có cách nào vẫn lấy dữ liệu từ file nguồn và vẫn không đóng nó lại hay không?
Mình gởi 2 file bạn xem thử. Bạn tải xuống và đổi đường dẫn ở ô B1 nhé.
Và tức là thêm một chút cho chủ đề này là lấy dữ liệu từ file đang đóng hoặc mở
@Nguyễn Hoàng Anh Thơ
Ý mình hỏi đúng như bạn nghĩ. Mình giải thích rõ hơn chút.
File đích: là file cần chép dữ liệu đến, và viết code trên file này.
File nguồn: theo như chủ đề ở đây là file đang đóng, cần lấy dữ liệu từ file này. File này mình xuất dữ liệu ra từ phần mềm khác và cập nhập (update) chép đè lên file này hàng tuần nên không thể share full được. Thông thường thì cũng ít khi phải mở ra nhưng vì lúc chạy thử code mình thấy xuất hiện sự việc là nếu đang mở thì nó sẽ bị đóng lại khi mở file đích nên mình có suy nghĩ có cách nào vẫn lấy dữ liệu từ file nguồn và vẫn không đóng nó lại hay không?
Mình gởi 2 file bạn xem thử. Bạn tải xuống và đổi đường dẫn ở ô B1 nhé.
Và tức là thêm một chút cho chủ đề này là lấy dữ liệu từ file đang đóng hoặc mở
Vậy thì copy toàn bộ code sau vào module1 của file "Book1-1.xlsm" xem thế nào ạ:
Mã:
Sub importData_test(ten_bat_ky As String)
Dim owb As Workbook, sh As Worksheet, tenfile As String, source_FileName As String
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets("Sheet1")
tenfile = sh.Range("B1")
source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
If bIsBookOpen(source_FileName) Then
Set owb = Workbooks(source_FileName)
owb.Sheets(ten_bat_ky).Range("A1:L30000").Copy
sh.Range("A3").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Else
Set owb = Workbooks.Open(tenfile)
owb.Sheets(ten_bat_ky).Range("A1:L30000").Copy
sh.Range("A3").PasteSpecial xlPasteAll
Application.CutCopyMode = False
owb.Close False
End If
Application.ScreenUpdating = False
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Sub ImportData()
Dim tenSheet As String
tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
Call importData_test(tenSheet)
End Sub
