Ekşi Duyuru

Merhabalar,

Ekleyeceğim kodda bir dosyadan değeri alıp diğer dosyaya yapıştırıp, sonra dosyayı farklı kaydedip kopyaladığım değeri dosya adına verip kaydediyorum. Bu dosyanın içinde 5 tane çalışma sayfası var ( adlarına 1,2,3,4,5 diyelim). Bunlardan 1,2,3,4 olanları silip, 5 olanın da içindeki tüm hücreleri kopyalayıp değer yapıştır yapmak istiyorum. Bilen arkadaş omuz verirse memnun olurum.

-------------------------------------------------------------------------------

Sub ExcelDosyalariOlustur()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim hedefHucresi As Range
Dim listeHucresi As Range
Dim isim As String

' Birinci dosyayı açın ve çalışma kitaplarını ve sayfalarını belirleyin
Set wb1 = Workbooks.Open("C:\Masaüstü\liste.xlsx") ' liste.xlsx'nin gerçek yolunu belirtin
Set ws1 = wb1.Sheets("Sayfa1") ' Sayfa adını belirtin

' İkinci dosyayı açın ve çalışma kitaplarını ve sayfalarını belirleyin
Set wb2 = Workbooks.Open("C:\Masaüstü\anadosya.xlsx") ' anadosya.xlsx'nin gerçek yolunu belirtin
Set ws2 = wb2.Sheets("İşemri") ' Sayfa adını belirtin

' Hedef hücreyi belirleyin (örneğin, B3 hücresi)
Set hedefHucresi = ws2.Range("B3")

' Birinci dosyadaki listenin kaç satır olduğunu belirleyin
Dim satir As Integer
satir = ws1.Cells(Rows.Count, 1).End(xlUp).Row

' Her bir satır için yeni bir Excel dosyası oluşturun
For i = 1 To satir
' Birinci dosyadan değeri alın
Set listeHucresi = ws1.Cells(i, 1)
isim = listeHucresi.Value

' İkinci dosyadaki hedef hücreye değeri kopyalayın
hedefHucresi.Value = listeHucresi

' Yeni bir Excel dosyası oluşturun ve kaydedin
wb2.SaveAs "C:\Masaüstü\" & listeHucresi & ".xlsx"


Next i

' Dosyaları kapatın
wb1.Close SaveChanges:=False
wb2.Close SaveChanges:=False
End Sub