Jeigu yra būdas padaryti geriau, atrask jį. T. A. Edison

Sveiki, Svečias
Prisijungimo vardas: Slaptažodis: Prisiminti mane
  • Puslapis:
  • 1

TEMA: Name Manager duomenų kopijavimas į kitus failus

Name Manager duomenų kopijavimas į kitus failus prieš 3 m. 3 mėn. #1

  • delfas2
  • delfas2 avataras
  • Neprisijungęs
  • Naujokas
  • Žinutės: 13
  • Reputacija: 0
Sveiki, turiu failą šabloną iš kurio informacija turi nukeliauti į kitus failus. Name Manager įrašų kopijavimui naudoju tokią macro komandą (žemiau). Kol kopijavimas vykdavo į xlsx failus, viskas buvo ok, tačiau dabar kopijuoti reikia į xlsm. Ir dabar komanda Name Manager įrašų neperkopijuoja. Tik atidaro failus ir uždaro. Ką čia pakeisti reikėtų, kad viskas vėl veiktų?

Sub Start()

'Declare variables
Dim NameOfMainWorkbook As String
Dim NameOfFile As String
Dim Folder As String
Dim NoOfFiles As Integer
Dim i As Integer

'Get the name of current file
NameOfMainWorkbook = ActiveWorkbook.Name

'Get number of files
NoOfFiles = ActiveWorkbook.ActiveSheet.Range("E3").Value

'Clear Status column
Sheets("Control Sheet").Select
Sheets("Control Sheet").Range("D:D").ClearContents
Range("D6").Value = "Status"

'Start processing files
For i = 1 To NoOfFiles
'Get the name of each file
NameOfFile = Cells(Range("B6").Row + i, Range("B6").Column + 1).Value
'Get the folder of each file
Folder = Cells(Range("B6").Row + i, Range("B6").Column).Value

'Open each file
Workbooks.Open Filename:=Folder & "\" & NameOfFile, UpdateLinks:=0


'Delete existing names
For Each vName In Workbooks(NameOfFile).Names
vName.Delete
Next vName

'Copy names from INPUT file
Set nms = Workbooks(NameOfMainWorkbook).Names
For r = 1 To nms.Count
Workbooks(NameOfFile).Names.Add nms(r).Name, nms(r).RefersTo
Next

'Close and save the file
Workbooks(NameOfFile).Close True
'Add status for each line in the file list
Workbooks(NameOfMainWorkbook).Worksheets("Control Sheet").Cells(Range("B6").Row + i, Range("B6").Column + 2).Value = "Opened"

Next i

'Save main file
Workbooks(NameOfMainWorkbook).Activate
ActiveWorkbook.Save


End Sub

Sub ListNamesToFirstSheet()
Set nms = ActiveWorkbook.Names
Set wks = Worksheets(1)
For r = 1 To nms.Count
wks.Cells(r, 2).Value = nms(r).Name
wks.Cells(r, 3).Value = "'" & nms(r).RefersTo
Next
End Sub
Administratorius uždraudė viešą pranešimų rašymą.

Name Manager duomenų kopijavimas į kitus failus prieš 3 m. 3 mėn. #2

  • hattrick
  • hattrick avataras
  • Neprisijungęs
  • Veteranas
  • Žinutės: 60
  • Gauta padėka 35
  • Reputacija: 8
Sveikas,

Pas mane veikia ir su .xlsm failu. Gali būti nekopijuoja todėl, kad execute'iną Sub ListNamesToFirstSheet, o ne Start Sub.
Papasakok plačiau, kur pas tave nurodyti Name Manager vardai ir kt.
Pabandžiau kodą su 1 .xlsm failu ir kitu .xlsx failu ir abiejuose atsirado aprašyti vardai.
Administratorius uždraudė viešą pranešimų rašymą.

Name Manager duomenų kopijavimas į kitus failus prieš 3 m. 3 mėn. #3

  • delfas2
  • delfas2 avataras
  • Neprisijungęs
  • Naujokas
  • Žinutės: 13
  • Reputacija: 0
Jo, čia viskas gerai :) pats apsižioplinęs buvau ir nurodęs ne tuos failų adresus , tai ji updateino man kitus failus :D
Administratorius uždraudė viešą pranešimų rašymą.
  • Puslapis:
  • 1
Moderatoriai: bankeris
Puslapio sukūrimo laikas: 0.251 sekundžių