Cách di chuyển file từ thư mục này sang thư mục khác

Làm cách nào để sao chép hoặc di chuyển tệp từ thư mục này sang thư mục khác dựa trên danh sách trong Excel?

Nếu bạn có danh sách tên tệp trong một cột trong trang tính và các tệp nằm trong một thư mục trong trình biên dịch của bạn. Tuy nhiên, bây giờ, bạn cần phải di chuyển hoặc sao chép các tệp này có tên được liệt kê vào trang tính từ thư mục gốc của chúng sang một tệp khác như ảnh chụp màn hình sau. Làm cách nào bạn có thể hoàn thành công việc này nhanh nhất có thể trong Excel?

Sao chép hoặc di chuyển tệp từ thư mục này sang thư mục khác dựa trên danh sách trong Excel với mã VBA

---

Sao chép hoặc di chuyển tệp từ thư mục này sang thư mục khác dựa trên danh sách trong Excel với mã VBA

Để di chuyển các tệp từ thư mục này sang thư mục khác dựa trên danh sách tên tệp, mã VBA sau đây có thể giúp ích cho bạn, vui lòng thực hiện như sau:

1. Giữ Alt + F11 các phím trong Excel và nó sẽ mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán mã VBA sau vào Cửa sổ mô-đun.

Mã VBA: Di chuyển tệp từ thư mục này sang thư mục khác dựa trên danh sách trong Excel

Sub movefiles() 'Updateby Extendoffice Dim xRg As Range, xCell As Range Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog Dim xSPathStr As Variant, xDPathStr As Variant Dim xVal As String On Error Resume Next Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8) If xRg Is Nothing Then Exit Sub Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xSFileDlg.Title = " Please select the original folder:" If xSFileDlg.Show <> -1 Then Exit Sub xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\" Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xDFileDlg.Title = " Please select the destination folder:" If xDFileDlg.Show <> -1 Then Exit Sub xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\" For Each xCell In xRg xVal = xCell.Value If TypeName(xVal) = "String" And xVal <> "" Then FileCopy xSPathStr & xVal, xDPathStr & xVal Kill xSPathStr & xVal End If Next End Sub

3. Và sau đó nhấn F5 để chạy mã này và một hộp nhắc sẽ bật ra để nhắc bạn chọn các ô chứa tên tệp, xem ảnh chụp màn hình:

4. Sau đó nhấn vào OK và trong cửa sổ bật ra, vui lòng chọn thư mục chứa các tệp bạn muốn di chuyển từ đó, xem ảnh chụp màn hình:

5. Và sau đó nhấp vào OK, hãy tiếp tục chọn thư mục đích nơi bạn muốn định vị các tệp trong một cửa sổ bật ra khác, xem ảnh chụp màn hình:

6. Cuối cùng, nhấp OK để đóng cửa sổ và bây giờ, các tệp đã được chuyển vào một thư mục khác mà bạn đã chỉ định dựa trên tên tệp trong danh sách trang tính, xem ảnh chụp màn hình:

Chú thích: Nếu bạn chỉ muốn sao chép các tệp vào một thư mục khác, nhưng vẫn giữ các tệp gốc, vui lòng áp dụng mã VBA bên dưới:

Mã VBA: Sao chép tệp từ thư mục này sang thư mục khác dựa trên danh sách trong Excel

Sub copyfiles() 'Updateby Extendoffice Dim xRg As Range, xCell As Range Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog Dim xSPathStr As Variant, xDPathStr As Variant Dim xVal As String On Error Resume Next Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8) If xRg Is Nothing Then Exit Sub Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xSFileDlg.Title = "Please select the original folder:" If xSFileDlg.Show <> -1 Then Exit Sub xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\" Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xDFileDlg.Title = "Please select the destination folder:" If xDFileDlg.Show <> -1 Then Exit Sub xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\" For Each xCell In xRg xVal = xCell.Value If TypeName(xVal) = "String" And xVal <> "" Then FileCopy xSPathStr & xVal, xDPathStr & xVal End If Next End Sub

---