Makro - uložení souboru Vyřešeno

[drumo]

Prosím o radu. Potřebuji jednoduché excel makro, které mi uloží kopii souboru do definovaného adresáře ve formátu třeba 000001.xlsx, tak, aby po každém dalším uložení číselná řada souborů narůstala a soubory se nepřepisovaly (000002.xlsx, 000003.xlsx...)

Po provedení tohoto makra (překlad názvů sloupců) potřebuji soubor někam uložit, vždy pod jiným názvem.
Díky za návrhy

Sub preloz()
'
' preloz Makro
'
' Klávesová zkratka: Ctrl+p
'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Pozice"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Oznacení"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Jednotka množství"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Počet"
Range("E1").Select
End Sub

[Reklama]

[cmuch]

Tady toto uloží soubor do stjného adresáře pod názvem 0000x.xlsm
Jako pomocná buňka slouží na Listu1 A1 lze změnit v makru

Dej na konec toho tvého

Kód: Vybrat vše


 ' ulozi kopii souboru jako
  ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Format(Sheets("List1").Range("A1") + 1, "00000") & ".xlsm"
  Sheets("List1").Range("A1") = Sheets("List1").Range("A1") + 1



+ tady je malá úprava toho tvého.

Kód: Vybrat vše

ub preloz()
'
' preloz Makro
'
' Klávesová zkratka: Ctrl+p
'
Range("A1").FormulaR1C1 = "Pozice"
Range("B1").FormulaR1C1 = "Oznacení"
Range("C1").FormulaR1C1 = "Jednotka množství"
Range("D1").FormulaR1C1 = "Počet"

End Sub

++
Vypad mi tam řádek

[drumo]

Díky moc, ale někde dělám asi chybu. Soubor bych potřeboval uložit do jiného adresáře než ten, který je otevřený. Přikládám soubor.

[X]

Místo nic neříkajících čísel 001, 002, 003, ... bych přešel na datum a čas, měl bys větší přehled. Doporučuji formát: rok(xxxx).měsíc(xx).den(xx) hodina(xx)-minuta(xx)-sekunda(xx) - nenastane tak problém se řazením ...

* xxxx.xx.xx xx-xx-xx

[drumo]

Prosím o úpravu poslaného souboru, jsem v tomhle směru naprostý začátečník, díky moc! Datum a čas bude lepší, to je fakt.

[cmuch]

Uprava makra na toto.

Kód: Vybrat vše

Sub preloz()
'
' Klávesová zkratka: Ctrl+p
'
  Range("A1").FormulaR1C1 = "Pozice"
  Range("B1").FormulaR1C1 = "Oznacení"
  Range("C1").FormulaR1C1 = "Jednotka množství"
  Range("D1").FormulaR1C1 = "Počet"

  ' ulozi kopii souboru jako do stejneho adresare
  ' pokud jinam tak "c:\cesta\" & Format(Now, "yyyy.mm.dd-hh.mm.ss") & ".xlsm"
  ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Format(Now, "yyyy.mm.dd-hh.mm.ss") & ".xlsm"
End Sub


V souboru to vypadá takto (viz.příloha).

[drumo]

Takto mi to již funguje, jen ještě jedna drobnost :). Po uložení do formátu .xlsx bez maker nelze poté uložený soubor otevřít, jde toto ještě nějak ošetřit? Díky

[cmuch]

To není tak jednoduché.
Jedna z možností je uložit kopii Listu1 do nového sešitu a ten uložit pod daným názvem.

Kód: Vybrat vše

Sub preloz()
'
' Klávesová zkratka: Ctrl+p
'
  Range("A1").FormulaR1C1 = "Pozice"
  Range("B1").FormulaR1C1 = "Oznacení"
  Range("C1").FormulaR1C1 = "Jednotka množství"
  Range("D1").FormulaR1C1 = "Počet"

  ' ulozi kopii listu do noveho sesitu
  Sheets("List1").Copy

  ' ulozi souboru jako do stejneho adresare
  ' pokud jinam tak "c:\cesta\" & Format(Now, "yyyy.mm.dd-hh.mm.ss") & ".xlsx"
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Now, "yyyy.mm.dd-hh.mm.ss") & ".xlsx"
  ActiveWorkbook.Close
End Sub

[drumo]

Díky moc za rady! Vše už funguje, tak, jak má.

[Rewqa]

Téma na žádost znovu otevřeno.

[drumo]

Mám prosím ještě jeden dotaz. Jedná se o další makro ve stále stejném excel souboru. Lze makrem vyřešit, aby výsledný soubor vypadal následovně? Viz. příloha. Tzn. aby se všechny vyplněné řádky v prvním sloupci očíslovaly a původní názvy v jednotlivých buňkách přesunuly za názvy ve sloupci B? Díky

[cmuch]

Tady toto by to mohlo splňovat.

Kód: Vybrat vše

Sub ocisluj()

Dim i, r As Long

i = 1

  For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row

    Cells(r, 2).Value = Cells(r, 2).Value & " " & Cells(r, 1)
    Cells(r, 1).Value = i
    i = i + 1
  Next r
End Sub