VBA Birden Çok Excel Dosyasını Tek Bir Çalışma Kitabında Birleştirin

Bu öğretici, birden çok Excel dosyasını VBA'da tek bir çalışma kitabında nasıl birleştireceğinizi gösterecektir.

VBA kullanarak bir dizi çalışma kitabından tek bir çalışma kitabı oluşturmak, izlenmesi gereken birkaç adım gerektirir.

• Kaynak verilerini istediğiniz çalışma kitaplarını seçmeniz gerekir - Kaynak dosyaları.
• Verileri koymak istediğiniz çalışma kitabını - Hedef dosyası - seçmeniz veya oluşturmanız gerekir.
• Gereksinim duyduğunuz Kaynak dosyalarından sayfaları seçmeniz gerekir.
• Verileri Hedef dosyasında nereye yerleştireceğinizi koda söylemeniz gerekir.

Tüm Açık Çalışma Kitaplarındaki Tüm Sayfaları Yeni Bir Çalışma Kitabında Ayrı Sayfalar Olarak Birleştirme

Aşağıdaki kodda, Excel'in açık dosyalar arasında dolaşacağı ve bilgileri yeni bir çalışma kitabına kopyalayacağı için bilgileri kopyalamanız gereken dosyaların açık olması gerekir. Kod Kişisel Makro Çalışma Kitabına yerleştirilir.

Bu dosyalar, açılması gereken SADECE Excel Dosyalarıdır.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Alt CombineMultipleFiles()Hatada GoTo eh'gerekli nesneleri tutmak için değişkenler bildirinÇalışma Kitabı Olarak Dim wbDestinationÇalışma Kitabı Olarak Dim wbSourceDim wsSource As Çalışma SayfasıÇalışma Kitabı Olarak Dim wbDim sh As Çalışma SayfasıDim strSheetName As StringDize Olarak Dim strDestName'işleri hızlandırmak için ekran güncellemesini kapatınApplication.ScreenUpdating = Yanlış'önce yeni hedef çalışma kitabı oluşturwbDestination = Çalışma Kitaplarını Ayarla.Add'yeni çalışma kitabının adını alın, böylece onu aşağıdaki döngüden hariç tutarsınızstrDestName = wbDestination.Name'şimdi verileri almak için açık olan çalışma kitaplarının her biri arasında dolaşın, ancak yeni kitabınızı veya Kişisel makro çalışma kitabını hariç tutunApplication.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewbSource = wb olarak ayarlawbSource.Worksheets'te Her sh içinsh.Copy After:=Çalışma Kitapları(strDestName).Tablolar(1)Sonraki saatBitirSonraki wb'şimdi yeni dosya ve Kişisel makro çalışma kitabı dışındaki tüm açık dosyaları kapatın.Application.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewb.Kapat YanlışBitirSonraki wb'birinci sayfayı hedef çalışma kitabından kaldırApplication.DisplayAlerts = YanlışSayfalar("Sayfa1").SilApplication.DisplayAlerts = Doğru'belleği serbest bırakmak için nesneleri temizleyinwbDestination = Hiçbir şey olarak ayarlawbSource = Hiçbir şey olarak ayarlawsSource = Hiçbir şey olarak ayarlawb = Hiçbir şey ayarla'Tamamlandığında ekran güncellemesini açApplication.ScreenUpdating = YanlışAlt Çıkışeh:MsgBox Err.AçıklamaAlt Bitiş

Prosedürü Excel ekranınızdan çalıştırmak için Makro iletişim kutusuna tıklayın.

Birleşik dosyanız şimdi görüntülenecektir.

Bu kod, her dosyanın içinden geçerek sayfayı yeni bir dosyaya kopyaladı. Dosyalarınızdan herhangi birinin birden fazla sayfası varsa - bunları da kopyalayacaktır - üzerlerinde hiçbir şey olmayan sayfalar da dahil!

Tüm Açık Çalışma Kitaplarındaki tüm Sayfaları Yeni Bir Çalışma Kitabında tek bir Çalışma Sayfasında birleştirme

Aşağıdaki yordam, tüm açık çalışma kitaplarındaki tüm sayfalardaki bilgileri, oluşturulan yeni bir çalışma kitabında tek bir çalışma sayfasında birleştirir.

Her sayfadan alınan bilgiler, çalışma sayfasındaki son dolu satırdaki hedef sayfaya yapıştırılır.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Alt CombineMultipleSheets()Hatada GoTo eh'gerekli nesneleri tutmak için değişkenler bildirinÇalışma Kitabı Olarak Dim wbDestinationÇalışma Kitabı Olarak Dim wbSourceDim wsDestination As Çalışma SayfasıÇalışma Kitabı Olarak Dim wbDim sh As Çalışma SayfasıDim strSheetName As StringDize Olarak Dim strDestNameiRws'yi Tamsayı Olarak KarartiCols'ü Tamsayı Olarak KarartınTamsayı Olarak Dim totRwsString As strEndRng DimAralık Olarak Dim rngSource'işleri hızlandırmak için ekran güncellemesini kapatınApplication.ScreenUpdating = Yanlış'önce yeni hedef çalışma kitabı oluşturwbDestination = Çalışma Kitaplarını Ayarla.Add'yeni çalışma kitabının adını alın, böylece onu aşağıdaki döngüden hariç tutarsınızstrDestName = wbDestination.Name'şimdi verileri almak için açık olan çalışma kitaplarının her biri arasında dolaşınApplication.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewbSource = wb olarak ayarlawbSource.Worksheets'te Her sh için'sayfadaki satır ve sütun sayısını alsh.EtkinleştirActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.Column'sayfadaki son hücrenin aralığını ayarlastrEndRng = sh.Cells(iRws, iCols).Adres'kopyalanacak kaynak aralığını ayarlaSet rngSource = sh.Range("A1:" & strEndRng)'hedef sayfadaki son satırı bulwbDestination.ActivatewsDestination = ActiveSheet'i ayarlawsDestination.Cells.SpecialCells(xlCellTypeLastCell).SeçtotRws = ActiveCell.Row'verileri yapıştırmak için yeterli satır olup olmadığını kontrol edintotRws + rngSource.Rows.Count > wsDestination.Rows.Count iseMsgBox "Konsolidasyon çalışma sayfasına veri yerleştirmek için yeterli satır yok."Git ehBitir'aşağıya sonraki satıra yapıştırmak için bir satır ekleyintotRws 1 ise totRws = totRws + 1rngSource.Copy Hedef:=wsDestination.Range("A" & totRws)Sonraki saatBitirSonraki wb'şimdi istediğiniz dışındaki tüm açık dosyaları kapatınApplication.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewb.Kapat YanlışBitirSonraki wb'belleği serbest bırakmak için nesneleri temizleyinwbDestination = Hiçbir şey olarak ayarlawbSource = Hiçbir şey olarak ayarlawsDestination = Hiçbir şey olarak ayarlarngSource = Hiçbir şey olarak ayarlawb = Hiçbir şey ayarla'Tamamlandığında ekran güncellemesini açApplication.ScreenUpdating = YanlışAlt Çıkışeh:MsgBox Err.AçıklamaAlt Bitiş

Tüm Açık Çalışma Kitaplarındaki tüm Sayfaları Etkin Çalışma Kitabında tek bir Çalışma Sayfasında birleştirme

Diğer tüm açık Çalışma Kitaplarındaki bilgileri şu anda çalışmakta olduğunuza getirmek istiyorsanız, aşağıdaki kodu kullanabilirsiniz.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting()Hatada GoTo eh'gerekli nesneleri tutmak için değişkenler bildirinÇalışma Kitabı Olarak Dim wbDestinationÇalışma Kitabı Olarak Dim wbSourceDim wsDestination As Çalışma SayfasıÇalışma Kitabı Olarak Dim wbDim sh As Çalışma SayfasıDim strSheetName As StringDize Olarak Dim strDestNameiRws'yi Tamsayı Olarak KarartiCols'ü Tamsayı Olarak KarartınTamsayı Olarak Dim totRwsDim rngEnd As StringAralık Olarak Dim rngSource'hedef kitap için etkin çalışma kitabı nesnesini ayarlawbDestination = ActiveWorkbook'u ayarla'aktif dosyanın adını alstrDestName = wbDestination.Name'işleri hızlandırmak için ekran güncellemesini kapatınApplication.ScreenUpdating = Yanlış'önce Aktif çalışma kitabınızda yeni hedef çalışma sayfası oluşturunApplication.DisplayAlerts = Yanlış'durum sayfası yoksa sonraki hatayı devam ettirHatada Devam Et SonrakiActiveWorkbook.Sheets("Konsolidasyon").Sil'sondaki hata tuzağına gitmek için hata tuzağını sıfırlaHatada GoTo ehApplication.DisplayAlerts = Doğru'çalışma kitabına yeni bir sayfa ekleActiveWorkbook ilewsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count)) olarak ayarlayınwsDestination.Name = "Birleştirme"İle bitmek'şimdi verileri almak için açık olan çalışma kitaplarının her biri arasında dolaşınApplication.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewbSource = wb olarak ayarlawbSource.Worksheets'te Her sh için'sayfadaki satır sayısını alsh.EtkinleştirActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivateiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells(iRws, iCols).AdresSet rngSource = sh.Range("A1:" & rngEnd)'hedef sayfadaki son satırı bulwbDestination.ActivatewsDestination = ActiveSheet'i ayarlawsDestination.Cells.SpecialCells(xlCellTypeLastCell).SeçintotRws = ActiveCell.Row'verileri yapıştırmak için yeterli satır olup olmadığını kontrol edinEğer totRws + rngSource.Rows.Count > wsDestination.Rows.Count iseMsgBox "Konsolidasyon çalışma sayfasına veri yerleştirmek için yeterli satır yok."Git ehBitir'1. satırda değilseniz bir sonraki satıra yapıştırmak için bir satır ekleyintotRws 1 ise totRws = totRws + 1rngSource.Copy Hedef:=wsDestination.Range("A" & totRws)Sonraki saatBitirSonraki wb'şimdi istediğiniz dışındaki tüm açık dosyaları kapatınApplication.Workbooks'ta Her wb içinEğer wb.Name strDestName Ve wb.Name "KİŞİSEL.XLSB" isewb.Kapat YanlışBitirSonraki wb'belleği serbest bırakmak için nesneleri temizleyinwbDestination = Hiçbir şey olarak ayarlawbSource = Hiçbir şey olarak ayarlawsDestination = Hiçbir şey olarak ayarlarngSource = Hiçbir şey olarak ayarlawb = Hiçbir şey ayarla'Tamamlandığında ekran güncellemesini açApplication.ScreenUpdating = YanlışAlt Çıkışeh:MsgBox Err.AçıklamaAlt Bitiş