Define a list of files as a variable target (VBA)

secoo140

Board Regular
Joined
Oct 12, 2013
Messages
85
Office Version
  1. 2010
Platform
  1. Windows
Hello,

I use a code to copy files to a template file, and delete old one, then save as old file's name.

But choosing every single file for like 500 files, is very boring.

Since, I do this operation once a week, now I need more clever way to do it.

I use "GetOpenFilename" in order to choose target and source.

and I have the exact path list of source.

"
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

"

thanks


VBA Code:
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
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hello,
Were you looking to loop through files in a folder and perform those same actions?
 
Upvote 0
Hello,
Were you looking to loop through files in a folder and perform those same actions?
Yes.

if the variable "fname" choose its path from the workbook I use,
Worksheets("liste"). range("a2 : a -last")
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top