Bu yazımızda, bir klasördeki birden çok çalışma kitabından yeni bir çalışma kitabına veri kopyalamak için bir makro oluşturacağız.
İki makro oluşturacağız; bir makro yalnızca ilk sütundaki kayıtları yeni çalışma kitabına kopyalar ve ikinci makro tüm verileri içine kopyalar.
Bu örnek için ham veriler, çalışanların devam kayıtlarından oluşmaktadır. TestFolder'da birden fazla Excel dosyamız var. Excel dosyalarının dosya adları, "ggmmyyy" biçiminde belirli bir tarihi temsil eder.
Her Excel dosyası, o gün orada bulunan çalışanların tarihini, çalışan kimliğini ve çalışan adını içerir.
İki makro oluşturduk; “CopyingSingleColumnData” ve “CopyingMultipleColumnData”. “CopyingSingleColumnData” makrosu, yalnızca klasördeki tüm dosyaların ilk sütunundaki kayıtları yeni çalışma kitabına kopyalayacaktır. “CopyingMultipleColumnData” makrosu, klasördeki tüm dosyalardan tüm verileri yeni çalışma kitabına kopyalayacaktır.
“Tek Sütun Kopyalama” butonu tıklanarak “CopyingSingleColumnData” makrosu çalıştırılabilir. “CopyingMultipleColumnData” makrosu “Copying Multiple Columns” butonu tıklanarak çalıştırılabilir.
Makroyu çalıştırmadan önce, metin kutusunda Excel dosyalarının yerleştirildiği klasörün yolu belirtilmelidir.
“Tek Sütun Kopyalama” butonuna tıklandığında, tanımlanan klasörde yeni bir "ConsolidatedFile" çalışma kitabı oluşturulacaktır. Bu çalışma kitabı, klasördeki tüm dosyaların ilk sütunundan konsolide verileri içerecektir.
Yeni çalışma kitabı yalnızca ilk sütundaki kayıtları içerecektir. Konsolide verilere sahip olduğumuzda, tarih sayısını sayarak belirli bir günde mevcut çalışan sayısını bulabiliriz. Belirli bir tarihin sayısı, o gün orada bulunan çalışan sayısına eşit olacaktır.
“Birden Çok Sütunu Kopyalama” butonuna tıklandığında tanımlanan klasörde yeni "ConsolidatedAllColumns" çalışma kitabını oluşturacaktır. Bu çalışma kitabı, klasördeki tüm dosyaların tüm kayıtlarından konsolide verileri içerecektir.
Oluşturulan yeni çalışma kitabı, klasördeki tüm dosyalardan tüm kayıtları içerecektir. Birleştirilmiş verilere sahip olduğumuzda, tüm katılım ayrıntıları tek bir dosyada mevcut olur. O gün bulunan çalışan sayısını kolayca bulabilir ve o gün orada bulunan çalışanların isimlerini de alabiliriz.
Kod açıklaması
Sheet1.TextBox1.Value
Yukarıdaki kod, “Sheet1” sayfasından “TextBox1” metin kutusuna eklenen değeri almak için kullanılır.
Dir(KlasörYolu & "*.xlsx")
Yukarıdaki kod, “.xlsx” dosya uzantısına sahip dosyanın adını almak için kullanılır. Birden çok karakterli dosya adı için joker karakter * kullandık.
DosyaAdı "" iken
Say1 = Say1 + 1
ReDim FileArray'i Koru (1'den Saymaya 1)
FileArray(Count1) = DosyaAdı
DosyaAdı = Dir()
Wend
Yukarıdaki kod, klasördeki tüm dosyaların dosya adlarını almak için kullanılır.
i = 1 için UBound(FileArray) için
Sonraki
Yukarıdaki kod, klasördeki tüm dosyalar arasında dolaşmak için kullanılır.
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Yukarıdaki kod, kaydı ilk sütundan hedef çalışma kitabına kopyalamak için kullanılır.
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Yukarıdaki kod, aktif çalışma kitabından tüm kayıtları hedef çalışma kitabına kopyalamak için kullanılır.
Lütfen kod için aşağıdan takip edin
Seçenek Explicit Sub CopyingSingleColumnData() 'Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderTextPath1 = Sheet1.ue değişkenlerini bildirme Ters eğik çizgi(\) eksikse klasör yoluna ters eğik çizgi ekleme Eğer Right(FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Excel dosyaları aranıyor DosyaAdı = Dir(FolderPath & "*.xlsx") Count1 = 0 'DosyaAdı "" iken Klasördeki tüm Excel dosyalarında dolaşmak Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Yeni bir çalışma kitabı oluşturma HedefWB'yi Ayarla = Workbooks.Add For i = 1 To UBound(FileArray) 'Çalışma kitabındaki son satırı bulma LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Excel çalışma kitabını açma Set SourceWB = Workbooks.Open (FolderPath & FileArray(i)) LastRow = ActiveCell.SpecialCells(xlCellTypeLas) tCell).Row 'Kopyalanan verileri hedef çalışma kitabındaki son satıra yapıştırma LastDesRow = 1 O zaman 'Hedef çalışma kitabında ilk sütunu son satıra kopyalama Range("A1", Cells(LastRow, 1)).Copy DestWB. ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Sonraki 'Yeni bir Excel'i kaydetme ve kapatma çalışma kitabı DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData() 'Değişkenleri bildirme DosyaAdı, Klasör Yolu, FileArray(), FileName1 As, String Last Dims LastRow , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Klasör yoluna ters eğik çizgi ekleme (\) eksikse Right(FolderPath, 1) "\" Sonra KlasörPath = FolderPath & "\" End If 'Excel dosyaları aranıyor DosyaAdı = Dir(FolderPath & "*.xlsx") Sayı1 = 0 'DosyaAdı "" Klasöründeki tüm Excel dosyaları arasında dolaşırken Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Yeni bir çalışma kitabı oluşturma HedefWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Çalışma kitabındaki son satırı bulma LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Excel çalışma kitabını açma Set SourceWB = Workbooks.Open &(FolderPath) FileArray(i)) 'Kopyalanan verileri hedef çalışma kitabındaki son satıra yapıştırma LastDesRow = 1 ise 'Çalışma sayfasındaki tüm verileri hedef çalışma kitabındaki son satıra kopyalama Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)). DestWB.ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Sonraki 'Kaydetme ve kapatma yeni bir Excel çalışma kitabı DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Hiçbir Şey Ayarlanmadı SourceWB = Hiçbir Şey Bitmedi Sub
Bu blogu beğendiyseniz, Facebook'ta arkadaşlarınızla paylaşın. Ayrıca bizi Twitter ve Facebook'ta da takip edebilirsiniz.
Sizden haber almayı çok isteriz, işimizi nasıl geliştirebileceğimizi ve sizin için nasıl daha iyi hale getirebileceğimizi bize bildirin. E-posta sitesinde bize yazın