Note: The other languages of the website are Google-translated. Back to English

Bagaimana cara menjalankan makro pada waktu yang sama di beberapa file buku kerja?

Artikel ini, saya akan berbicara tentang cara menjalankan makro di beberapa file buku kerja secara bersamaan tanpa membukanya. Metode berikut dapat membantu Anda menyelesaikan tugas ini di Excel.

Jalankan makro secara bersamaan di beberapa buku kerja dengan kode VBA


Jalankan makro secara bersamaan di beberapa buku kerja dengan kode VBA

Untuk menjalankan makro di beberapa buku kerja tanpa membukanya, harap terapkan kode VBA berikut:

1. Tahan ALT + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Klik Menyisipkan > Modul, dan tempelkan makro berikut di file Modul Jendela.

Kode VBA: Jalankan makro yang sama di beberapa buku kerja secara bersamaan:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Note: Pada kode di atas, silahkan copy dan paste kode Anda sendiri tanpa Sub menuju dan End Sub footer antara Dengan Workbooks.Open (xFdItem & xFileName) serta Berakhir dengan skrip. Lihat tangkapan layar:

doc menjalankan beberapa file makro 1

3. Lalu tekan F5 kunci untuk menjalankan kode ini, dan a Browse jendela ditampilkan, pilih folder yang berisi buku kerja yang Anda ingin semua menerapkan makro ini, lihat tangkapan layar:

doc menjalankan beberapa file makro 2

4. Dan kemudian klik OK tombol, makro yang diinginkan akan dijalankan sekaligus dari satu buku kerja ke yang lain.

 


Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda dengan
80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari
    300
    fitur yang kuat
    . Mendukung Office/Excel
    2007-2019 dan 365
    . Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap
    30
    percobaan gratis -hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda dengan
    50%
    , dan mengurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah

 

Urutkan komentar berdasarkan
komentar (39)
Rated 4.5 dari 5 · peringkat 1
Komentar ini diminimalkan oleh moderator di situs
Makro yang sangat berguna, dan berfungsi dengan baik, tetapi saya ingin dapat memilih file mana dari folder yang saya inginkan untuk menjalankan makro? File tidak dibuat secara otomatis di folder terpisah, dan saya perlu menjalankan makro yang berbeda pada setiap kumpulan file dari folder itu, lalu memindahkannya kembali ke folder awal.
Komentar ini diminimalkan oleh moderator di situs
Saya mengikuti instruksi tetapi mendapatkan kesalahan kompilasi "Loop tanpa Do". Apa yang saya lewatkan? Kode makro saya sangat sederhana, cukup ubah ukuran font dari baris yang ditentukan. Bekerja dengan sendirinya. Ini yang saya punya ... tolong bantu

Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open (xFdItem & xFileName)
'kode Anda di sini
Baris("2:8").Pilih
Dengan Pilihan.Font
.Nama = "Arial"
.Ukuran = 12
.Dicoret = Salah
.Superskrip = Salah
.Subskrip = Salah
.OutlineFont = Salah
.Bayangan = Salah
.Underline = xlUnderlineStyleNone
.Warna = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Berakhir dengan
xFileName = Dir
Lingkaran
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Halo, yarta,
Anda melewatkan skrip "Akhiri dengan" di akhir kode Anda, yang benar seharusnya ini:
Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open (xFdItem & xFileName)
'kode Anda di sini
Baris("2:8").Pilih
Dengan Pilihan.Font
.Nama = "Arial"
.Ukuran = 16
.Dicoret = Salah
.Superskrip = Salah
.Subskrip = Salah
.OutlineFont = Salah
.Bayangan = Salah
.Underline = xlUnderlineStyleNone
.Warna = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Berakhir dengan
Berakhir dengan
xFileName = Dir
Lingkaran
End If
End Sub

Silakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
Makro yang sangat berguna, dan berfungsi dengan baik, tetapi saya ingin dapat memilih file mana dari folder yang saya inginkan untuk menjalankan makro? Misalnya saya memiliki 4 file dalam folder dengan file excel lainnya dan saya hanya ingin menjalankannya pada 4 file tertentu. Bagaimana saya bisa men-tweak makro Anda untuk membiarkan saya memilih 4 file itu dari folder itu?
Komentar ini diminimalkan oleh moderator di situs
Hai, Joel,
Untuk memicu kode yang sama di buku kerja tertentu, Anda harus menerapkan kode di bawah ini:

Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Redupkan xFB Sebagai String
Dengan Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Benar
.Filter.Hapus
.Filter.Tambahkan "excel", "*.xls*"
.Menunjukkan
Jika .SelectedItems.Count < 1 Kemudian Keluar Sub
Untuk lngCount = 1 Ke .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Jika xFileName <> "" Kemudian
Dengan Workbooks.Open(Filename:=xFileName)
'kode Anda
Berakhir dengan
End If
lngCount berikutnya
Berakhir dengan
End Sub

Silakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
terima kasih, sangat membantu
Komentar ini diminimalkan oleh moderator di situs
Hai!

Saya mencoba memasukkan kode saya ke dalam kode Anda dan ketika saya menjalankan makro itu memberi saya pesan berikut: Kesalahan run-time '429': ActiveX tidak dapat membuat objek. Mohon sarannya bagaimana cara memperbaikinya. Terima kasih!

kode saya:

Atur RInput = Range("A2:A21")
Tetapkan ROoutput = Rentang("D2:D22")

Redup A() Sebagai Varian
Redim A(1 Ke RInput.Rows.Count, 0)
A = RInput.Nilai2

Set d = CreateObject("Scripsting.Dictionary")

Untuk i = 1 Ke UBound(A)
Jika d.Ada(A(i, 1)) Maka
d(A(i, 1)) = d(A(i, 1)) + 1
Lain
d.Tambahkan A(i, 1), 1
End If
Next
Untuk i = 1 Ke UBound(A)
A(i, 1) = d(A(i, 1))
Next

Keluaran RO = A
Komentar ini diminimalkan oleh moderator di situs
Hai, pertama-tama terima kasih untuk makro ini, persis seperti yang saya cari. Namun saya punya satu masalah, apakah ada cara untuk menutup dan menyimpan setiap jendela saat selesai. Saya memiliki banyak file dan saya kehabisan RAM sebelum eksekusi selesai.
Komentar ini diminimalkan oleh moderator di situs
Ya, Tambahkan saja kode berikut di bawah ini jika Anda ingin menyimpan file dengan nama yang sama:

'Menyimpan Buku Kerja
ActiveWorkbook.Simpan
Komentar ini diminimalkan oleh moderator di situs
Halo, Caitlin,
Mungkin kode di bawah ini dapat membantu Anda, setiap kali setelah menjalankan kode spesifik Anda, kotak prompt simpan file akan muncul mengingatkan Anda untuk menyimpan buku kerja.

Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Redupkan xWB Sebagai Buku Kerja
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Lakukan Sementara xFileName <> ""
Setel xWB = Workbooks.Open(xFdItem & xFileName)
Dengan xWB
'kode Anda di sini
Berakhir dengan
xWB.Tutup
xFileName = Dir
Lingkaran
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai!

Saya mencoba memasukkan kode saya ke dalam kode Anda dan ketika saya menjalankan makro itu memberi saya pesan berikut: Kesalahan run-time '429': ActiveX tidak dapat membuat objek. Mohon sarannya bagaimana cara memperbaikinya. Terima kasih!

kode saya:

Atur RInput = Range("A2:A21")
Tetapkan ROoutput = Rentang("D2:D22")

Redup A() Sebagai Varian
Redim A(1 Ke RInput.Rows.Count, 0)
A = RInput.Nilai2

Set d = CreateObject("Scripsting.Dictionary")

Untuk i = 1 Ke UBound(A)
Jika d.Ada(A(i, 1)) Maka
d(A(i, 1)) = d(A(i, 1)) + 1
Lain
d.Tambahkan A(i, 1), 1
End If
Next
Untuk i = 1 Ke UBound(A)
A(i, 1) = d(A(i, 1))
Next

Keluaran RO = A
Komentar ini diminimalkan oleh moderator di situs
Halo,

Saya telah berhasil menggunakan makro ini untuk memformat file NBA untuk 30 tim masing-masing dengan bukunya sendiri. Kemarin, saya menerima pesan kesalahan dan bahwa Modul (makro) tidak dapat diselesaikan atau dihapus atau diedit (untuk disimpan). Ini telah merusak buku kerja makro pribadi saya dan membuat Excel hampir tidak dapat digunakan untuk saya. Itu membuat aplikasi mogok setiap kali saya mencoba mengakses makro dari file apa pun. Dukungan Excel dan dukungan Windows belum mampu memperbaiki banyak hal. Bisakah kamu menolong?
Komentar ini diminimalkan oleh moderator di situs
Hai, Apakah ada cara saya dapat menentukan tujuan file dalam skrip itu sendiri. Saya ingin melewati proses 3 di mana kita harus menelusuri folder tertentu.
Komentar ini diminimalkan oleh moderator di situs
Hai, terima kasih untuk kode ini. dapatkah Anda memberi tahu saya bagaimana saya bisa mendapatkan hasil makro saya yang saya buka semua buku kerja dalam satu lembar (hasil setiap buku kerja berturut-turut)? dan apakah ada cara untuk menambahkan nama setiap buku kerja ke baris dengan data dari langkah sebelumnya?
Komentar ini diminimalkan oleh moderator di situs
Hi

Saya mendapat kesalahan run-time 1004: sintaks tidak benar ketika saya menjalankan kode berikut yang merupakan Perpanjang Office VBA ke "Jalankan makro secara bersamaan di beberapa buku kerja dengan kode VBA" dengan Perpanjang Office VBA "Hapus semua rentang bernama dengan kode VBA" di masukkan slot kode Anda:

Sub LoopThroughFiles()

Redupkan xFd Sebagai FileDialog

Redupkan xFdItem Sebagai Varian

Redupkan xFileName Sebagai String

Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)

Jika xFd.Tunjukkan = -1 Maka

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

Lakukan Sementara xFileName <> ""

Dengan Workbooks.Open (xFdItem & xFileName)

' Sub HapusNama()

'Perbarui 20140314

Dim xName Sebagai Nama

Untuk Setiap xName Di Application.ActiveWorkbook.Names

xName.Hapus

Next


Berakhir dengan

xFileName = Dir

Lingkaran

End If

End Sub

Apa yang saya coba lakukan adalah menjalankan makro yang menghapus rentang bernama dalam delapan buku kerja yang terdapat dalam folder yang sama.

BTW, ini pertama kalinya saya menggunakan sesuatu dari Extend Office dan tidak berfungsi. Website ini sangat membantu saya.

Saran/komentar akan sangat dihargai.

aldc
Komentar ini diminimalkan oleh moderator di situs
Halo, aldc,
Kode Anda berfungsi dengan baik di buku kerja saya, versi Excel mana yang Anda gunakan?
Komentar ini diminimalkan oleh moderator di situs
Halo, kode ini sangat bagus dan bermanfaat. Saya banyak menggunakannya!

Saat ini, di organisasi saya, kami sekarang menggunakan SharePoint untuk menyimpan file kami. Apakah ada cara untuk membuat kode ini berfungsi di semua file dalam folder sharepoint?
Komentar ini diminimalkan oleh moderator di situs
Halo, terima kasih untuk kode ini.
Apakah ada cara untuk mengulang sub-folder juga? Katakanlah saya memiliki satu folder dan di dalam folder sepuluh folder lagi masing-masing berisi file excel.

Apakah ada cara untuk memilih folder utama sehingga kode berjalan melalui semua subfoldernya?

Terima kasih.
Komentar ini diminimalkan oleh moderator di situs
Hai, Darko,Untuk menjalankan kode dari folder dengan subfolder, silakan terapkan kode berikut: Sub LoopThroughFiles_Subfolders (xStrPath Sebagai String)
Dim xSFolderName
Redupkan xFileName
Redupkan xArrSFPath() Sebagai String
Redupkan xI Sebagai Integer
Jika xStrPath = "" Kemudian Keluar Sub
xFileName = Dir(xStrPath & "*.xls*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open(xStrPath & xFileName)
'kode Anda di sini
Berakhir dengan
xFileName = Dir
Lingkaran
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
Redim xArrSFPath(0)
Lakukan Sementara xSFolderName <> ""
Jika xSFolderName <> "." Dan xSFolderName <> ".." Lalu
If (GetAttr(xStrPath & xSFolderName) Dan vbDirectory) = vbDirectory Kemudian
xI = xI + 1
ReDim Pertahankan xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xSFolderName = Dir
Lingkaran
Jika UBound(xArrSFPath) > 0 Kemudian
Untuk xI = 0 Ke UBound(xArrSFPath)
LoopThroughFiles_Subfolder (xArrSFPath(xI))
xI berikutnya
End If
End Sub
Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolder (xFdItem)
End If
End SubSilakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
Selain kode di atas, apakah mungkin untuk membuka file excel dalam urutan kronologis yang saya inginkan?
Komentar ini diminimalkan oleh moderator di situs
Hai pertama-tama, terima kasih banyak untuk makronya yang sangat berguna untuk digunakan. Saya hanya ingin tahu apakah kami memiliki cara untuk me-refresh folder di onedrive melalui makro. Jika ya, bisakah Anda memberi tahu saya apa yang dapat saya lakukan di sini untuk menyegarkan file di onedrive menggunakan skrip makro?
Komentar ini diminimalkan oleh moderator di situs
Hai, terima kasih banyak untuk skrip ini, saya bekerja sangat baik untuk saya, tetapi saya memiliki kebutuhan khusus: Apakah ada cara untuk mengubah skrip untuk menerapkan kode saya dengan kondisi nama file DAN dalam subfolder?
Saya menjelaskan: Saya seorang guru dan saya membuat solusi excel untuk menyimpan hasil siswa dan memungkinkan guru untuk berkonsultasi dengan mereka. Untuk melakukannya, saya memiliki file per mata pelajaran sekolah dan satu untuk kelas yang bertanggung jawab, semua dalam folder per kelas.
Jadi ketika saya menemukan bug atau optimasi, saya harus melaporkan perubahan di semua file di semua subfolder.
Tetapi karena semua file tidak sama (organisasi subjet yang berbeda), saya ingin cara menerapkan contoh kode par saya ke semua file bernama "kelas matematika" di semua subfolder, atau sebaliknya, untuk menerapkan kode saya ke semua file di subfolder kecuali semua file bernama "xyz".Terima kasih !Fabrice
Komentar ini diminimalkan oleh moderator di situs
Kode yang Anda berikan tidak berfungsi dengan VBA berikut, bisakah Anda membantuSub Bundles()

Redupkan vWS Sebagai Lembar Kerja
redup vA, vA2()
Redupkan vR Selamanya, vSum Selamanya, vC Selamanya
Redupkan vN Selama, vN2 Selama, vN3 Selama

Setel vWS = ActiveSheet
Dengan vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Baris
vJumlah = Aplikasi.Jumlah(.Range("D2:D" & vR))
ReDim Pertahankan vA2(1 Hingga vSum, 1 Hingga 4)
vA = .Range("A2:D" & vR)
Untuk vN = 1 Ke vR - 1
Untuk vN2 = 1 Ke vA(vN, 4)
vC = vC + 1
Untuk vN3 = 1 Sampai 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 berikutnya
vN2 berikutnya
vN berikutnya
Berakhir dengan
vC = 1
Untuk vN = 1 Ke vSum - 2
vA2(vN, 4) = vC
Jika vA2(vN + 1, 2) = vA2(vN, 2) Maka
vC = vC + 1
vA2(vN + 1, 4) = vC
Lain
vA2(vN + 1, 4) = 1
vC = 1
End If
vN berikutnya
Application.ScreenUpdating = Salah
Lembar.Tambahkan
Dengan ActiveSheet
vWS.Range("A1:D1"). Salin .Range("A1:D1")
.Sel(2, 1).Ubah ukuran(vSum, 4) = vA2
Berakhir dengan
Application.ScreenUpdating = Benar

End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya ingin menjalankan VBA ini menjadi beberapa Lembar dalam satu folder sekaligus, bisakah Anda membantuSub Bundel()

Redupkan vWS Sebagai Lembar Kerja
redup vA, vA2()
Redupkan vR Selamanya, vSum Selamanya, vC Selamanya
Redupkan vN Selama, vN2 Selama, vN3 Selama

Setel vWS = ActiveSheet
Dengan vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Baris
vJumlah = Aplikasi.Jumlah(.Range("D2:D" & vR))
ReDim Pertahankan vA2(1 Hingga vSum, 1 Hingga 4)
vA = .Range("A2:D" & vR)
Untuk vN = 1 Ke vR - 1
Untuk vN2 = 1 Ke vA(vN, 4)
vC = vC + 1
Untuk vN3 = 1 Sampai 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 berikutnya
vN2 berikutnya
vN berikutnya
Berakhir dengan
vC = 1
Untuk vN = 1 Ke vSum - 2
vA2(vN, 4) = vC
Jika vA2(vN + 1, 2) = vA2(vN, 2) Maka
vC = vC + 1
vA2(vN + 1, 4) = vC
Lain
vA2(vN + 1, 4) = 1
vC = 1
End If
vN berikutnya
Application.ScreenUpdating = Salah
Lembar.Tambahkan
Dengan ActiveSheet
vWS.Range("A1:D1"). Salin .Range("A1:D1")
.Sel(2, 1).Ubah ukuran(vSum, 4) = vA2
Berakhir dengan
Application.ScreenUpdating = Benar

End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya mencoba menjalankan kode tetapi kesalahan "424: Objek Diperlukan" muncul di baris "Dengan Workbooks.Open(xFdItem & xFileName)". Dengan melihat lebih dalam, ternyata buku kerja excel yang tersimpan di folder yang diinginkan tidak muncul/ada (Ketika jendela dibuka dengan tampilan kode, jika saya mencoba membuka folder dan tidak memilihnya, itu kosong). Bagaimana?
Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open (xFdItem & xFileName)
Sheets.Add Setelah:=ActiveSheet
Sheets("Sheet2").Pilih
Sheets("Sheet2").Nama = "Tuan"
Sheets("Master").Pilih
Sheets("Master").Pindahkan Sebelum:=Sheets(1)
Berakhir dengan
xFileName = Dir
Lingkaran
End If
End Sub


Bisakah Anda membantu saya menyelesaikan masalah ini?
Komentar ini diminimalkan oleh moderator di situs
Ini adalah situs web favorit saya dengan instruksi yang paling jelas (lebih dari video YouTube mana pun) dan saya terus mengunjunginya lagi dan lagi. Terima kasih banyak untuk tutorial ini - Anda adalah penyelamat mahasiswa pascasarjana yang sedih.
Komentar ini diminimalkan oleh moderator di situs
Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").SeluruhColumn.Pilih
Seleksi.Sisipkan Shift:=xlToRight
Sel Aktif.Pilih
Berakhir dengan
xFileName = Dir
Lingkaran
End If
Akhiri Sub, mohon bantuannya. BTW, ekstensi file excel saya adalah (.csv - "comma delimited") . dan saya memiliki 500 file excel dalam satu folder dengan rata-rata setiap baris kira-kira 500000 jumlah baris.. Mohon Bantuannya. Saya hanya ingin memasukkan kolom di setiap buku kerja
Komentar ini diminimalkan oleh moderator di situs
apakah kamu pernah mendapatkan jawaban atas pertanyaanmu? Saya mencoba melakukan hal yang sama pada lebih dari 3700 file csv. Saya hanya perlu menambahkan 1 kolom (A).
Komentar ini diminimalkan oleh moderator di situs
Hai, membutuhkan dan Carly, Untuk mengatasi masalah Anda, untuk menjalankan kode untuk beberapa file CSV, Anda hanya perlu mengubah ekstensi file .xls menjadi .csv seperti kode di bawah ini: Sub LoopThroughFiles()
Redupkan xFd Sebagai FileDialog
Redupkan xFdItem Sebagai Varian
Redupkan xFileName Sebagai String
Setel xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jika xFd.Tunjukkan = -1 Maka
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Lakukan Sementara xFileName <> ""
Dengan Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").SeluruhColumn.Select
Seleksi.Sisipkan Shift:=xlToRight
Sel Aktif.Pilih
Berakhir dengan
xFileName = Dir
Lingkaran
End If
End SubSilakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
Hai, apakah mungkin menjalankan makro hanya di lembar buku kerja yang berbeda dengan nama tertentu? Terima kasih!!
Komentar ini diminimalkan oleh moderator di situs
Hai, Sara,
Maaf, tidak ada solusi yang baik untuk masalah yang Anda angkat.
Terima kasih!
Belum ada komentar yang diposting di sini
Muat Lebih
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan

Ikuti kami

Hak Cipta © 2009 - www.extendoffice.com. | Seluruh hak cipta. Dipersembahkan oleh ExtendOffice. | Peta Situs
Microsoft dan logo Office adalah merek dagang atau merek dagang terdaftar dari Microsoft Corporation di Amerika Serikat dan / atau negara lain.
Dilindungi oleh Sectigo SSL