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

Bir dizindeki dosyalar arasında nasıl geçiş yapılır ve verileri Excel'deki bir ana sayfaya kopyalarım?

Bir klasörde birden çok Excel çalışma kitabı olduğunu varsayarsak ve tüm bu Excel dosyaları arasında döngü yapmak ve aynı addaki belirli çalışma sayfalarından verileri Excel'de bir ana çalışma sayfasına kopyalamak istiyorsanız, ne yapabilirsiniz? Bu makale, bunu başarmak için ayrıntılı bir yöntem sunar.

Bir dizindeki dosyalar arasında döngü yapın ve verileri VBA kodu ile bir ana sayfaya kopyalayın


Bir dizindeki dosyalar arasında döngü yapın ve verileri VBA kodu ile bir ana sayfaya kopyalayın

A1: D4 aralığındaki belirtilen verileri belirli bir klasördeki tüm çalışma kitaplarından 1 çalışma sayfasından bir ana sayfaya kopyalamak istiyorsanız, lütfen aşağıdaki işlemleri gerçekleştirin.

1. Çalışma kitabında bir ana çalışma sayfası oluşturacaksınız, Ara Toplam + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. içinde Uygulamalar için Microsoft Visual Basic Pencere, tıklayın Ekle > modül. Ardından, VBA kodunu kod penceresine kopyalayın.

VBA kodu: bir klasördeki dosyalar arasında döngü yapın ve verileri bir ana sayfaya kopyalayın

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

not:

1). Kodda, "A1: D4"Ve"Sheet1"Tüm Sheet1'in A4: D1 aralığındaki verilerin ana sayfaya kopyalanacağı anlamına gelir. Ve "Yeni Tabaka", Yeni oluşturulan ana sayfanın adıdır.
2). Belirli klasördeki Excel dosyaları açılmamalıdır.

3. Tuşuna basın. F5 kodu çalıştırmak için anahtar.

4. Açılışta Araştır penceresi, lütfen döngü yapacağınız dosyaları içeren klasörü seçin ve ardından OK buton. Ekran görüntüsüne bakın:

Ardından, mevcut çalışma kitabının sonunda "Yeni Sayfa" adlı bir ana çalışma sayfası oluşturulur. Ve seçilen klasördeki tüm Sayfa1'in A4: D1 aralığındaki veriler çalışma sayfasının içinde listelenir.


İlgili yazılar:


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (20)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
vba kodu için teşekkürler! Mükemmel çalışıyor! Bunun yerine DEĞER OLARAK YAPIŞTIRMAm gerekirse kodun ne olduğunu bilmek ister misiniz? Şimdiden teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Lai Ling,
Aşağıdaki kod sorunu çözmenize yardımcı olabilir. Yorumun için teşekkür ederim.

Alt Merge2MultiSheets()
Aralık olarak Dim xRg
Varyant Olarak Dim xSelItem
Dim xFileDlg FileDialog Olarak
xFileName, xSheetName, xRgStr'yi String Olarak Kısın
Karartma xBook, xWorkBook Çalışma Kitabı Olarak
Çalışma Sayfası Olarak xSheet'i Karartın
On Error Resume Next
Application.DisplayAlerts = Yanlış
Application.EnableEvents = Yanlış
Application.ScreenUpdating = Yanlış
xSheetName = "Sayfa1"
xRgStr = "A1:D4"
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın
xFileDlg ile
Eğer .Show = -1 ise
xSelItem = .SelectedItems.Item(1)
xWorkBook'u ayarla = ThisWorkbook
xSheet = xWorkBook.Sheets ("Yeni Sayfa") olarak ayarlayın
xSheet Hiçbir Şey Değilse
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Yeni Sayfa"
xSheet = xWorkBook.Sheets ("Yeni Sayfa") olarak ayarlayın
Eğer son
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
xFileName = "" ise, Sub'dan Çıkın
xFileName = "" Kadar Yapın
xBook = Workbooks.Open(xSelItem & "\" & xFileName) ayarla
xRg = xBook.Worksheets(xSheetName).Range(xRgStr) olarak ayarlayın
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dizin()
xBook.Kapat
döngü
Eğer son
İle bitmek
xRg = xSheet.UsedRange olarak ayarlayın
xRg.ClearFormats
xRg.UseStandardHeight = Doğru
xRg.UseStandardWidth = Doğru
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, kod için teşekkürler. Lütfen veri aralığının kopyalandığı Excel dosya adını nasıl ekleyebileceğimi bana bildirir misiniz? Bu harika bir yardım olurdu!

Teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Eğitim için teşekkürler.

Nasıl yapardım: Yalnızca "Sayfa1"deki satırı "toplam" satırındaki değerlerle kopyalayın ve "Yeni Sayfa" adlı ana çalışma sayfasına [dosyaadı] ile yapıştırın. Toplam ile satırın not edilmesi, her çalışma sayfasında farklı olabilir.

Örneğin:
Dosya1: Sayfa1
Sütun1, Sütun2, Sütun
1,2,15
Sonuç,10,50

Dosya2: Sayfa1
Sütun1, Sütun2, Sütun
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Sonuç,300,500

MasterFile: "Yeni Sayfa":
dosya1, 10, 50
dosya2, 300, 500
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Bu harika çalışıyor. Formülü değil, sadece değerleri almak için değiştirmenin bir yolu var mı?
Teşekkürler !!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Trish
Aşağıdaki kod sorunu çözmenize yardımcı olabilir. Yorumun için teşekkür ederim.

Alt Merge2MultiSheets()
Aralık olarak Dim xRg
Varyant Olarak Dim xSelItem
Dim xFileDlg FileDialog Olarak
xFileName, xSheetName, xRgStr'yi String Olarak Kısın
Karartma xBook, xWorkBook Çalışma Kitabı Olarak
Çalışma Sayfası Olarak xSheet'i Karartın
On Error Resume Next
Application.DisplayAlerts = Yanlış
Application.EnableEvents = Yanlış
Application.ScreenUpdating = Yanlış
xSheetName = "Sayfa1"
xRgStr = "A1:D4"
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın
xFileDlg ile
Eğer .Show = -1 ise
xSelItem = .SelectedItems.Item(1)
xWorkBook'u ayarla = ThisWorkbook
xSheet = xWorkBook.Sheets ("Yeni Sayfa") olarak ayarlayın
xSheet Hiçbir Şey Değilse
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Yeni Sayfa"
xSheet = xWorkBook.Sheets ("Yeni Sayfa") olarak ayarlayın
Eğer son
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
xFileName = "" ise, Sub'dan Çıkın
xFileName = "" Kadar Yapın
xBook = Workbooks.Open(xSelItem & "\" & xFileName) ayarla
xRg = xBook.Worksheets(xSheetName).Range(xRgStr) olarak ayarlayın
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dizin()
xBook.Kapat
döngü
Eğer son
İle bitmek
xRg = xSheet.UsedRange olarak ayarlayın
xRg.ClearFormats
xRg.UseStandardHeight = Doğru
xRg.UseStandardWidth = Doğru
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, hala değerleri değil formülleri çekiyor, bu yüzden bana #REF hatası veriyor. Bir yerde .PasteSpecial xlPasteValues'a ihtiyacı olabileceğini biliyorum ama nerede olduğunu bulamıyorum. Yardım edebilir misin? Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Bunun için teşekkürler.


Tüm klasörler ve alt klasörler arasında dolaşmak ve yukarıdaki kopyayı gerçekleştirmek için kodu nasıl dahil edebilirim?


Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba - Bu kod, elde etmeye çalıştığım şey için mükemmel.

Tüm klasörler ve alt klasörler arasında dolaşmanın ve kopyalamayı gerçekleştirmenin bir yolu var mı?


Teşekkürler!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba - Bu kod, her dosya için ilk 565 satır için çok iyi çalışır, ancak sonraki tüm satırlar bir sonraki dosya ile örtüşür.
Bunu düzeltmenin bir yolu var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Teşekkürler - bir çalışma kitabındaki her bir çalışma sayfasından (özel değerler) ana Ana dosya içindeki ayrı sayfalara nasıl kopyalanıp yapıştırılabilir?
Bu yorum sitedeki moderatör tarafından en aza indirildi
hücre boşsa kodun boş bırakılmasını nasıl sağlarsınız?
Bu yorum sitedeki moderatör tarafından en aza indirildi
benim için, dosyalarımın her biri için "Sayfa1" sekme adı değişir. Örneğin, Tab1, Tab2, Tab3, Tab4... Excel'de bir listeden geçmek için bir döngü nasıl kurabilirim ve "Sayfa1" adını her şeyi geçene kadar değiştirmeye devam edebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Nick, Aşağıdaki VBA kodu sorunu çözmenize yardımcı olabilir. Lütfen bir deneyin. Alt LoopThroughFileRename()
Extendofice 2021/12/31 tarafından güncellendi
Aralık olarak Dim xRg
Varyant Olarak Dim xSelItem
Dim xFileDlg FileDialog Olarak
xFileName, xSheetName, xRgStr'yi String Olarak Kısın
Karartma xBook, xWorkBook Çalışma Kitabı Olarak
Çalışma Sayfası Olarak xSheet'i Karartın
Sayfa Olarak Dim xShs
Dim xName As Dize
Tamsayı olarak xFNum Dim
On Error Resume Next
Application.DisplayAlerts = Yanlış
Application.EnableEvents = Yanlış
Application.ScreenUpdating = Yanlış
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın
xFileDlg.Göster
xSelItem = xFileDlg.SelectedItems.Item(1)
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Yaparken xFileName <> ""
xWorkBook = Workbooks olarak ayarlayın.Open(xSelItem & "\" & xFileName)
xShs = xWorkBook.Sheets olarak ayarlayın
xFNum için = 1 ila xShs.Count
xSheet = xShs.Item(xFNum) olarak ayarlayın
xName = xSheet.Name
xName = Değiştir(xName, "yaprak""çıkıntı") 'Sayfayı Sekme ile Değiştir
xSheet.Name = xName
Sonraki
xWorkBook.Kaydet
xWorkBook.Kapat
xFileName = Dizin()
döngü
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, içinde sayfaları bulunan 6 farklı çalışma kitabındaki (bir klasördeki) verileri YENİ WORKBOOK'a kopyalamak için bir kod istiyorum. vba'da
lütfen bana yardım et asp
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Paranuşa,
Aşağıdaki makaledeki VBA komut dosyası, birden çok çalışma kitabını veya belirtilen çalışma kitabı sayfalarını bir ana çalışma kitabında birleştirebilir. Lütfen yardımcı olup olamayacağını kontrol edin.
Birden Fazla Çalışma Kitabını Excel'de Tek Bir Ana Çalışma Kitabında Nasıl Birleştirirsiniz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Olá bom dia.
Önemli bilgiler, daha önce hiç olmadığı kadar ilgili.
Kesin hükümler, 2.400'ün en üst düzeydeki pastalar ile ilgili olarak, farklı e n o estão en iyi yapılandırma yapılandırmaları. Beni kıskandırmak için VBA'yı kontrol et, essas izlenimlerini otomatikleştir? Ben ajudaria muito, obrigada.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Maria Soares,
Lütfen aşağıdaki gönderideki VBA kodunun yardımcı olup olmadığını kontrol edin.
Excel'de birden çok çalışma kitabı nasıl yazdırılır?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Senaryom benzer, ancak her dosyada hepsi farklı adlara sahip ancak dosyalar arasında tutarlı olan birden çok sayfam var. Dosyalardaki verileri kopyalayıp (değerleri) ana çalışma kitabındaki belirli sayfa adlarına yapıştırmak için bu kodu Döngüye almanın bir yolu var mı? Ana dosyadaki sayfa adları, dosyalardakilerle aynıdır. Onlar arasında döngü yapmak istiyorum. Ayrıca, her bir sayfadaki veri miktarı değişeceğinden, her bir sayfadaki verileri şuna benzer bir şey kullanarak seçmem gerekecek:

Aralık("A1").Seçin
Aralık (Selection, Selection.End (xlDown)). Seçin
Aralık(Seçim, Seçim.Son(xlToRight))).Seçim


Dosya sayfası adları, Verme, Hizmetler, Sigorta, Araba, Diğer Giderler, vb...

Şimdiden teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Andrew Shahan,
Aşağıdaki VBA kodu sorununuzu çözebilir. Kodu çalıştırdıktan ve bir klasör seçtikten sonra, kod çalışma sayfasını ada göre otomatik olarak eşleştirecek ve verileri ana çalışma kitabındaki aynı adlı çalışma sayfasına yapıştıracaktır.
Sub Merge2MultiSheets()
'Updated by Extendoffice 20221209
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook As Workbook, xMainBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set xMainBook = ThisWorkbook
    
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            
            Do Until xFileName = ""
            Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)

            For Start = 1 To xBook.Worksheets.Count
                Set xSheet = xBook.Worksheets.Item(Start)
                xSheet.Activate
                xSheetName = xSheet.Name
                xSheet.UsedRange.Copy (xMainBook.Worksheets.Item(xSheetName).Range("A1048576").End(xlUp).Offset(1, 0))
            Next
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır