Code lấy dữ liệu từ file excel đóng cùng một folder (1 người xem)

[destinythanhphuong]

Chào các anh chị
Hiện em đang dùng code bên dưới lấy file excel, tuy nhiên đường dẫn cố định , em muốn hỏi có cách nào nhanh thay đổi đường dẫn, nếu copy về folder máy tính ở nhà. em cám ơn

Private Sub CommandButton2_Click()Dim DiaChi As String
DiaChi = "V:\Plant Department\Supply chain\PLANNING GROUP\TONG HOP\2016\data"
With Workbooks.Open(DiaChi & "WIP.xlsx")
Sheets("Sheet1").Range("A1").Value = "=Counta(A2:A20000)"
Calculate
.Close 1
End With
Range("A4").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A2"
Range("B1").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A1"
Range("a4").Select
Selection.Copy
Range("A4").Resize(Range("B1").Value, 32).Select ' so 3 la so cot can lay
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Calculate
Range("A4").Resize(Range("C1").Value, 32).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[giaiphap]

Thì bạn thay đổi đường dẫn như sau:

DiaChi=ThisWorkbook.Path

 

[destinythanhphuong]

Mình sửa lại , nhưng khi chạy thì xuất hiện màn hình chọn tới file open tới 3 lần lận.
Mình muốn để file cần lấy dữ liệu vào folder data thì sửa lại code như thế nào ?
cám ơn bạn

 

[Hau151978]

Bạn nên đưa file lên. Cuối đường dẫn của bạn thiếu dấu \. Bạn thử thay

diachi=thisworkbook.path & "data\"

 

[destinythanhphuong]

Bạn nên đưa file lên. Cuối đường dẫn của bạn thiếu dấu \. Bạn thử thay

diachi=thisworkbook.path & "[COLOR=#b22222]\data\[/COLOR]"

Mình thử cách bạn làm rất tốt, sửa lại chút xíu

 

[destinythanhphuong]

Chào các anh chị
Trường hợp em muốn chọn đến 1 file , và thực hiện copy 1 vùng đến file hiện hành thì sửa code lại như thế nào, em cám ơn

 

[quanluu]

Chào các anh chị
Trường hợp em muốn chọn đến 1 file , và thực hiện copy 1 vùng đến file hiện hành thì sửa code lại như thế nào, em cám ơn

bạn thay đổi 2 dòng này

DiaChi = Application.GetOpenFilename
With Workbooks.Open(DiaChi)

 

[destinythanhphuong]

Bạn Quân

hai dòng sau mình sửa lại như thế nào

Range("A4").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A2"
Range("B1").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A1"

 

[quanluu]

Bạn Quân

hai dòng sau mình sửa lại như thế nào

Range("A4").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A2"
Range("B1").Value = "='" & DiaChi & "[WIP.xlsx]Sheet1'!A1"

Ở đây bạn dùng cách link file nên mình cũng biên dịch theo link file như sau:
bạn thêm biến Pos
Dim Pos as integer
pos = InStr(1, StrReverse(DiaChi), "")
Range("A4").Value = "='" & Left(DiaChi, Len(DiaChi) - pos + 1) & "[" & Right(DiaChi, pos - 1) & "]Sheet1'!A2"
Range("B1").Value = "='" & Left(DiaChi, Len(DiaChi) - pos + 1) & "[" & Right(DiaChi, pos - 1) & "]Sheet1'!A1"

 

[destinythanhphuong]

Báo lỗi khi chạy code, bạn xem dùm

 

[quanluu]

Báo lỗi khi chạy code, bạn xem dùm

code thiếu phần bôi đỏ. Bạn sửa và check lại nha.
pos = InStr(1, StrReverse(DiaChi), "\")

 

[destinythanhphuong]

Bạn xem thư tổng thể , sao mình chạy vẫn lỗi, mình thêm "" rồi.

Private Sub CommandButton2_Click()Dim DiaChi As String
DiaChi = Application.GetOpenFilename
With Workbooks.Open(DiaChi)
Sheets("THEO SAN PHAM").Range("A2").Value = "=Counta(A2:A20000)"
Calculate
.Close 1
End With
Dim Pos As Integer
Pos = InStr(1, StrReverse(DiaChi), "")
Range("A4").Value = "='" & Left(DiaChi, Len(DiaChi) - Pos + 1) & "[" & Right(DiaChi, Pos - 1) & "]THEO SAN PHAM'!A5"
Range("B1").Value = "='" & Left(DiaChi, Len(DiaChi) - Pos + 1) & "[" & Right(DiaChi, Pos - 1) & "]THEO SAN PHAM'!A2"
Range("a4").Select
Selection.Copy
Range("A4").Resize(Range("B1").Value, 19).Select ' so 3 la so cot can lay
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Calculate
Range("A4").Resize(Range("C1").Value, 19).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[quanluu]

Bạn xem thư tổng thể , sao mình chạy vẫn lỗi, mình thêm "" rồi.

không có file rất khó check bạn ah.
Bạn kt lại code:
Sai: Pos = InStr(1, StrReverse(DiaChi), "")
Đúng: Pos = InStr(1, StrReverse(DiaChi), "\")

 

[destinythanhphuong]

Gửi bạn file, mục đích của mình là lấy data từ file kế hoạch sheet theo san pham sang file MDS.

Bạn xem dùm mình, cám ơn bạn

 

[destinythanhphuong]

Mình không hiểu sao khi chạy code trên file tổng hợp thì không được, tách riêng file ra thì chạy được,