Soru Sıralı yapılan kopyalama işlemi için hedefi liste ile vermek

[seckinb]

Merhaba,
her bir hedefi tek tek seçerek dosyalar arasında kopyalama yapıyorum.

Kopyalamak istediğim verinin aslında hedefi belli.

Bunu tanımlamakta zorlanıyorum.

Tek tek seçme kodum:

Sub fname2()

fname1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls?", , "yeni - hedef dosyayı seçelim")
If fname1 = "False" Then Exit Sub

For yeniA = 1 To 10

fname = Application.GetOpenFilename("Excel Files (*.xls*), *.xls?", , "eski - kaynak dosyayı seçelim")
If fname = "False" Then Exit Sub


Set w2 = Workbooks.Open(fname)
Set s2 = w2.Sheets(1)
Set w3 = Workbooks.Open(fname1)

w2.Activate

For Each sh In Worksheets
    sh.Unprotect "sb123"
Next

ActiveSheet.Cells.UnMerge

w2.Worksheets("kanlar").Range("A2:N50").Copy
w3.Worksheets("kanlar").Range("A2").PasteSpecial Paste:=xlPasteFormulas
 
w2.Worksheets("doz").Range("A2:H10").Copy
w3.Worksheets("doz").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Görüntülemeler").Range("A2:F50").Copy
w3.Worksheets("Görüntülemeler").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Dozimetri").Range("A2:T50").Copy
w3.Worksheets("Dozimetri").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Konsey_ekibi").Range("A2:J100").Copy
w3.Worksheets("Konsey_ekibi").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("kimlik").Range("C1").Copy
w3.Worksheets("kimlik").Range("C1").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("C2").Copy
  w3.Worksheets("kimlik").Range("C2").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("C3").Copy
  w3.Worksheets("kimlik").Range("C3").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("C5").Copy
  w3.Worksheets("kimlik").Range("C5").PasteSpecial Paste:=xlPasteValues
    
    w2.Worksheets("kimlik").Range("H1").Copy
  w3.Worksheets("kimlik").Range("H1").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("H2").Copy
  w3.Worksheets("kimlik").Range("H2").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("H3").Copy
  w3.Worksheets("kimlik").Range("H3").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("B9").Copy
  w3.Worksheets("kimlik").Range("B9").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("D7").Copy
  w3.Worksheets("kimlik").Range("D7").PasteSpecial Paste:=xlPasteValues
 
        w2.Worksheets("kimlik").Range("D9").Copy
  w3.Worksheets("kimlik").Range("D9").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("F7").Copy
  w3.Worksheets("kimlik").Range("F7").PasteSpecial Paste:=xlPasteValues
 
        w2.Worksheets("kimlik").Range("F9").Copy
  w3.Worksheets("kimlik").Range("F9").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("H7").Copy
  w3.Worksheets("kimlik").Range("H7").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("H9").Copy
  w3.Worksheets("kimlik").Range("H9").PasteSpecial Paste:=xlPasteValues
 
        w2.Worksheets("kimlik").Range("J9").Copy
  w3.Worksheets("kimlik").Range("J9").PasteSpecial Paste:=xlPasteValues
 
        w2.Worksheets("kimlik").Range("J7").Copy
  w3.Worksheets("kimlik").Range("J7").PasteSpecial Paste:=xlPasteValues
 
          w2.Worksheets("kimlik").Range("F11").Copy
  w3.Worksheets("kimlik").Range("F11").PasteSpecial Paste:=xlPasteValues
 
          w2.Worksheets("kimlik").Range("I11").Copy
  w3.Worksheets("kimlik").Range("I11").PasteSpecial Paste:=xlPasteValues
 
'EX TARİHİ
          w2.Worksheets("kimlik").Range("I5").Copy
  w3.Worksheets("kimlik").Range("I5").PasteSpecial Paste:=xlPasteValues
 
'HİKAYE
    w2.Worksheets("kimlik").Range("B19:B23").Copy
  w3.Worksheets("kimlik").Range("B19:B23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("B28:B32").Copy
  w3.Worksheets("kimlik").Range("B28:B32").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("E19:E23").Copy
  w3.Worksheets("kimlik").Range("E19:E23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("E28:E32").Copy
  w3.Worksheets("kimlik").Range("E28:E32").PasteSpecial Paste:=xlPasteValues
 
'PATOLOJİ
    w2.Worksheets("kimlik").Range("A39").Copy
  w3.Worksheets("kimlik").Range("A39").PasteSpecial Paste:=xlPasteValues
 'OYKÜ
 
  w3.Worksheets("kimlik").oyku1.Value = w2.Worksheets("kimlik").oyku1.Value
 
  Application.CutCopyMode = False

w2.Close 0
Kill fname
w3.Worksheets("Formlar").Select
w3.SaveAs Filename:=fname
w3.Close 0

Next yeniA

End Sub

D:\EDU\TRT\Y-90\0480_SAMİ_ULUÇAY_TRT_TEDAVİSİZ\0480_SAMİ_ULUÇAY_TRT_TEDAVİSİZ.xlsm

D:\EDU\TRT\Y-90\0481_NEBAHAT_GUZEL_LK\0481_NEBAHAT_GUZEL.xlsm

D:\EDU\TRT\Y-90\0482_ARIF_GULEREV_TRT\0482_ARIF_GULEREV.xlsm

w2 olarak tanımlamasını istediğim hedefler şu şekilde adreste sabit durmakta.
bu listeyi vererek dosya sayısı kadar loop yapmasını ve o kadar bu işlemi gerçekleştirmesini nasıl sağlarım?

 

[seckinb]

Örnek olarak kullandığım dosya.