Soru Açık olan dosyayı kapanan dosyanın üzerine yazmak

seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
Merhaba

eski dosyamı, şablon dosyamın üzerine kopyaladıktan sonra
eski dosyamı silip, onun ismini ile aynı hedefe farklı kaydetmek istiyorum.

w2 = eski dosya
w3 = açık olan şablon.
PHP: 
Sub fname2()
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls", , "*")
If fName = "False" Then Exit Sub


fname1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls", , "*")
If fname1 = "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:=xlPasteValues
 
w2.Worksheets("doz").Range("a2:d50").Copy
w3.Worksheets("doz").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Görüntülemeler").Range("a2:d50").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:M100").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("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
 
 
    w2.Worksheets("kimlik").Range("B19:B23").Copy
  w3.Worksheets("kimlik").Range("B19:B23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("B24:B29").Copy
  w3.Worksheets("kimlik").Range("B28:B33").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("D19:D23").Copy
  w3.Worksheets("kimlik").Range("E19:E23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("D24:D29").Copy
  w3.Worksheets("kimlik").Range("E28:E33").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("A39").Copy
  w3.Worksheets("kimlik").Range("A39").PasteSpecial Paste:=xlPasteValues
 
  w2.Worksheets("kimlik").Range("a12").Copy
  w3.Worksheets("kimlik").oyku1.Paste
 
  Application.CutCopyMode = False

w2.Close 0
w3.Worksheets("Formlar").Select
End Sub
w3'ü w2'nin yerine farklı kaydetmek istiyorum.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Dosyalarınızın yedeğini alarak aşağıdaki kodları deneyin.
Kod: 
Sub fname2()
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls", , "*")
If fName = "False" Then Exit Sub
fname1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls", , "*")
If fname1 = "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:=xlPasteValues
 
w2.Worksheets("doz").Range("a2:d50").Copy
w3.Worksheets("doz").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Görüntülemeler").Range("a2:d50").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:M100").Copy
w3.Worksheets("Konsey_ekibi").Range("A2").PasteSpecial Paste:=xlPasteValues
 Set s1 = w2.Worksheets("kimlik")
  Set s2 = w3.Worksheets("kimlik")
s2.Range("C1").Value = s1.Range("C1").Value
 s2.Range("C2").Value = s1.Range("C2").Value
s2.Range("C3").Value = s1.Range("C3").Value
s2.Range("C5").Value = s1.Range("C5").Value
s2.Range("H1").Value = s1.Range("H1").Value
s2.Range("H2").Value = s1.Range("H2").Value
s2.Range("H3").Value = s1.Range("H3").Value
s2.Range("B9").Value = s1.Range("B9").Value
s2.Range("D7").Value = s1.Range("D7").Value
s2.Range("F7").Value = s1.Range("F7").Value
s2.Range("F9").Value = s1.Range("F9").Value
s2.Range("H7").Value = s1.Range("H7").Value
s2.Range("H9").Value = s1.Range("H9").Value
s2.Range("J9").Value = s1.Range("J9").Value
s2.Range("J7").Value = s1.Range("J7").Value
s2.Range("F11").Value = s1.Range("F11").Value
s2.Range("I11").Value = s1.Range("I11").Value
s2.Range("B19:B23").Value = s1.Range("B19:B23").Value
s2.Range("B28:B33").Value = s1.Range("B24:B29").Value
s2.Range("E19:E23").Value = s1.Range("D19:D23").Value
s2.Range("E28:E33").Value = s1.Range("D24:D29").Value
s2.Range("A39").Value = s1.Range("A39").Value
w2.Worksheets("kimlik").Range("a12").Copy
w3.Worksheets("kimlik").oyku1.Paste
  Application.CutCopyMode = False
  Dim frm As Long
yol = w2.FullName
frm = w2.FileFormat
w2.Close 0
Application.DisplayAlerts = False
w3.SaveAs Filename:=yol, FileFormat:=frm

w3.Worksheets("Formlar").Select
End Sub
 
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
Şu şekilde bir çözüm buldum.
Eskiyi kapattıktan sonra sildirip onun adına yeniyi kaydettirdim. :)

Kill fname
w3.SaveAs Filename:=fname
w3.Close 0


PHP: 
Sub fname2()

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

'fname1 = "D:\EDU\TRT\deneme\yeni.xlsm"

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:=xlPasteValues
 
w2.Worksheets("doz").Range("a2:d50").Copy
w3.Worksheets("doz").Range("A2").PasteSpecial Paste:=xlPasteValues
 
w2.Worksheets("Görüntülemeler").Range("a2:d50").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:M100").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("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
 
 
    w2.Worksheets("kimlik").Range("B19:B23").Copy
  w3.Worksheets("kimlik").Range("B19:B23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("B24:B29").Copy
  w3.Worksheets("kimlik").Range("B28:B33").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("D19:D23").Copy
  w3.Worksheets("kimlik").Range("E19:E23").PasteSpecial Paste:=xlPasteValues
 
      w2.Worksheets("kimlik").Range("D24:D29").Copy
  w3.Worksheets("kimlik").Range("E28:E33").PasteSpecial Paste:=xlPasteValues
 
    w2.Worksheets("kimlik").Range("A39").Copy
  w3.Worksheets("kimlik").Range("A39").PasteSpecial Paste:=xlPasteValues
 
  w2.Worksheets("kimlik").Range("a12").Copy
  w3.Worksheets("kimlik").oyku1.Paste
 
  Application.CutCopyMode = False

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

Next yeniA

End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst