wsNew.PasteSpecial (xlPasteValues)citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Kopirování tabulky do souboru
předčasná radost...
RunTime Error 1004: Method "PasteSpecial" of object "_WorkSheet" failedcitovat
Díky, pomoc určitě neodmítnu...
Ideální by bylo, kdyby si makro zjistilo názvy listů/souborů. Každý rok se mění, nemusel bych je opravovat v kodu :-)citovat
Upraveno, odzkoušeno.
Pracuje bezchybně.
Děkuji citovat
MS Excel
Téma: Kopirování tabulky do souboru 
Zaslal/a GeorgeK 2.12.2019 9:22
Dobrý den
Sešit ma několik listů. Pomocí makra ukládám každý list (po doplnění dat, aktualizaci) jako samostatný soubor - viz část kodu níže.
Funguje, jen jsem dostal připomínku, že v nových souborech jsou linky na soubor původní. Ukládají se totiž vzorce.
Jdu si pro radu jak "cestou nejmenšího odporu", nejmenší změnou kodu vkládat VYSLEDKY ne vzorce.
Díky za váš čas a radu :-)
…
Set wb = ThisWorkbook
Set ws = wb.Sheets(„AAA“)
Set wbNew = Workbooks.Add
Cesta = „D:\pokus\2020\“
With wbNew
Set wsNew = wbNew.Sheets(„List1“)
wsNew.Name = ws.Name
ws.Rows.Copy
wsNew.Paste
soubor = „pokus_ „ & ws.Name & „ .xlsx“
On Error Resume Next
.SaveAs Filename:=cesta & soubor
On Error GoTo 0
End with
…
Stalker napsal/a:
wsNew.PasteSpecial (xlPasteValues)
předčasná radost...
RunTime Error 1004: Method "PasteSpecial" of object "_WorkSheet" failedcitovat
Podľa mňa je takýto postup celý zle. Skúste kopírovať celý list, nie riadky. Potom stačí hodnotu použitých buniek nahradiť vlastnou hodnotou. Pr.:
Sub pokus()
Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet
Dim cesta As String, soubor As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("AAA")
cesta = "D:\pokus\2020\"
soubor = "pokus_ " & ws.Name & " .xlsx"
Application.ScreenUpdating = False
ws.Copy
Set wbNew = ActiveWorkbook
With wbNew
With .Sheets("AAA").UsedRange
.Value = .Value
End With
On Error Resume Next
.SaveAs Filename:=cesta & soubor
If Err.Number = 0 Then .Close False
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
Chcete aby som Vám to upravil nech to spraví všetky listy ?citovat
Sub pokus()
Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet
Dim cesta As String, soubor As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("AAA")
cesta = "D:\pokus\2020\"
soubor = "pokus_ " & ws.Name & " .xlsx"
Application.ScreenUpdating = False
ws.Copy
Set wbNew = ActiveWorkbook
With wbNew
With .Sheets("AAA").UsedRange
.Value = .Value
End With
On Error Resume Next
.SaveAs Filename:=cesta & soubor
If Err.Number = 0 Then .Close False
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
Chcete aby som Vám to upravil nech to spraví všetky listy ?citovat
elninoslov napsal/a:
Chcete aby som Vám to upravil nech to spraví všetky listy ?
Díky, pomoc určitě neodmítnu...
Ideální by bylo, kdyby si makro zjistilo názvy listů/souborů. Každý rok se mění, nemusel bych je opravovat v kodu :-)citovat
Skúste na kópii dát.
Ak by išlo o viac listov (desiatky), stálo by za zváženie uložiť ich na pozadí v novej inštancii Excelu, ktorá sa síce na začiatku dlhšie otvára (ako nový zošit), no je skrytá, a rýchlejšia. A mohol by Vám bežať aj progres v StatusBar-e.
Ak by išlo o viac listov (desiatky), stálo by za zváženie uložiť ich na pozadí v novej inštancii Excelu, ktorá sa síce na začiatku dlhšie otvára (ako nový zošit), no je skrytá, a rýchlejšia. A mohol by Vám bežať aj progres v StatusBar-e.
Příloha: 
45171_listy-do-samostatnych-souboru.zip (20kB, staženo 24x)
citovat45171_listy-do-samostatnych-souboru.zip (20kB, staženo 24x)Skúste na kópii dát.
Ak by išlo o viac listov (desiatky), stálo by za zváženie uložiť ich na pozadí v novej inštancii Excelu,
Díky, vyzkouším.
Jedná se (v současnosti) o 5 listů. Max to vidím do 10.citovat
Ak by išlo o viac listov (desiatky), stálo by za zváženie uložiť ich na pozadí v novej inštancii Excelu,
Díky, vyzkouším.
Jedná se (v současnosti) o 5 listů. Max to vidím do 10.citovat
elninoslov napsal/a:
Skúste na kópii dát.
...
Upraveno, odzkoušeno.
Pracuje bezchybně.
Děkuji citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články