Excel- ում ցուցակի հիման վրա ինչպե՞ս պատճենել կամ տեղափոխել ֆայլերը մի թղթապանակից մյուսը:
Եթե ունեք աշխատանքային թերթի սյունակում ֆայլերի անունների ցուցակ, և ֆայլերը տեղադրվում են ձեր համակարգչի թղթապանակում: Բայց հիմա, դուք պետք է տեղափոխեք կամ պատճենեք այս ֆայլերը, որոնց անունները նշված են աշխատաթերթում իրենց սկզբնական թղթապանակից մյուսը, ինչպես ցույց է տրված հետևյալ նկարը: Ինչպե՞ս կարող եք այս գործն ավարտել որքան հնարավոր է արագ Excel- ում:
Պատճենել կամ տեղափոխել ֆայլերը մի թղթապանակից մյուսը ՝ հիմնվելով Excel- ի ցուցակում ՝ VBA կոդով
Պատճենել կամ տեղափոխել ֆայլերը մի թղթապանակից մյուսը ՝ հիմնվելով Excel- ի ցուցակում ՝ VBA կոդով
Ֆայլերը մի թղթապանակից մյուսը տեղափոխելու համար ՝ հիմնվելով ֆայլերի անունների ցուցակի վրա, հետևյալ VBA կոդը կարող է ձեզ լավություն բերել, արեք հետևյալ կերպ.
1, Պահեք պահեք Alt + F11 Excel- ի ստեղները, և այն բացում է Microsoft Visual Basic հավելվածների համար պատուհան.
2: Սեղմեք Տեղադրել > Մոդուլներև տեղադրեք հետևյալ VBA կոդը Մոդուլի պատուհանում:
VBA կոդ. 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, Եվ հետո սեղմեք F5 այս կոդն աշխատեցնելու բանալին, և կհայտնվի հուշման տուփ ՝ հիշեցնելու համար, որ ընտրեք ֆայլերի անունները պարունակող բջիջները, տես նկարի նկարը.
4. Այնուհետեւ կտտացրեք OK կոճակը, և դուրս եկած պատուհանում ընտրեք այն թղթապանակը, որը պարունակում է այն ֆայլերը, որոնցից ցանկանում եք տեղափոխել, տեսեք,
5. Եվ այնուհետեւ կտտացրեք OK, շարունակեք ընտրել նպատակակետի պանակը, որտեղ ցանկանում եք ֆայլերը տեղակայել մեկ այլ դուրս եկած պատուհանում, տե՛ս նկարը.
6. Վերջապես, կտտացրեք OK պատուհանը փակելու համար, և այժմ ֆայլերը տեղափոխվել են ձեր նշած մեկ այլ պանակ ՝ հիմնվելով աշխատանքային թերթիկների ցուցակում գտնվող ֆայլերի անունների վրա, տե՛ս նկարը.
ՆշումԵթե պարզապես ցանկանում եք պատճենել ֆայլերը մեկ այլ պանակում, բայց պահեք բնօրինակ ֆայլերը, ապա կիրառեք ստորև նշված VBA կոդը:
VBA կոդ. Պատճենեք ֆայլերը մի թղթապանակից մյուսը ՝ 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
Գրասենյակի արտադրողականության լավագույն գործիքները
Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար: Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...
Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք
- Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
- Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
- Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր: