imam problem sa kodom pa mi je potrebna pomoć. posle pokretanja macro-a izbaci mi "run-time error 1004" kliknem na End lepo prebaci podatke u novu tabelu samo što mi malo zatupi excel. problem mi oznaci na kraju koda "nm.Delete"
evo i koda
Option Explicit
Sub CreateDataSheet()
Dim ws As Worksheet
Dim sDataOutputName As String
With Application
.Cursor = xlWait
.StatusBar = "Saving DataSheet..."
.ScreenUpdating = False
' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("RAZRADA UKUPNO", "RAZRADA KUPCI BG", "RAZRADA KUPCI LA", "RAZRADA KUPCI NI", _
"RAZRADA GRUPA BG", "RAZRADA GRUPA LA", "RAZRADA GRUPA NI")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
With ws.UsedRange
.Value = .Value
End With
'ws.Cells.Copy
'ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
'Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
RemNamedRanges
' Sheets("Cover Sheet").Select
' sDataOutputName = Sheets("CalcSheet").Range("N9").Value & "\" & Sheets("CalcSheet").Range("B2").Value
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs sDataOutputName & " MyNewDataWorkbook - Data Sheet.xlsx"
ActiveWorkbook.Close SaveChanges:=False
.Cursor = xlDefault
.StatusBar = False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub
Sub RemNamedRanges()
Dim nm As Name
On Error Resume Next
For Each nm In ActiveWorkbook.Names
nm.Delete '***************************** ovde mi javlja grešku*********************
Next
On Error GoTo 0
End Sub
Potpis
INTRUDER