jeste mala priloha, odstranil jsme nektere listy aby to nebylo moc velke
Příloha: 
21879_priprava.zip (161kB, staženo 13x)
citovat21879_priprava.zip (161kB, staženo 13x)
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: Aktualizace sbirky z jineho sesitu
MS Excel
Téma: Aktualizace sbirky z jineho sesitu 
Zaslal/a agaslayer 14.10.2014 21:01
Zdravim, udelal jsem si sbirku (katalog) v excelu. Sbirka je v sesite, ktery ma listy A az Z. Sbirka uz ma hodne udaju. Uvazoval jsem jak si sbirku aktualizovat, pokud tuto sbirku dam i par kamaradum. Vymyslel jsem tedy, ze to bude skrze novy sesit, ktery se bude treba jmenovat Update a bude zase obsahovat listy A az Z.
Ted bych potreboval makro, ktere by umelo vzit data (muze byt pevna hodnota treba 100 radku) z listu A sesitu Update a vlozilo na prvni volny radek listu A sbirky. Neco jsem zkousel i skrze zaznam, prislo mi to ale hodne komplikovane. Dohledal jsem nekolik maker, ale neumim udelat tak, aby to vzalo vice radku a ne porad jen jeden. Diky za napady a pomoc
Zásadně si myslím, že kopírovat obrázky je celkem problém v rámci maker, protože ty se nevážou na buňku, ale prostě na pozici..
jinak bych volil něco tohoto
<code>
Sub update()
Dim i As Long
Dim j As String
For i = 1 To ThisWorkbook.Worksheets.Count
Windows("Xl0000037.xls").Activate
ThisWorkbook.Sheets(i).Select
j = ActiveSheet.Name
lastCol = ActiveSheet.Range("I3").Column
lastRow = ActiveSheet.Cells(65536, 1).End(xlUp).Row
ActiveSheet.Range("a3:" & _
ActiveSheet.Cells(lastRow, lastCol).Address).Select
Selection.Copy
Windows("update-test.xlsx").Activate 'pokud bude tento sešit také otevřený
Sheets(j).Select
If Range("A3").Value = "" Then
Range("A3").Select
Else
Range("A2").Select
Selection.End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next i
End Sub
</code>citovat
jinak bych volil něco tohoto
<code>
Sub update()
Dim i As Long
Dim j As String
For i = 1 To ThisWorkbook.Worksheets.Count
Windows("Xl0000037.xls").Activate
ThisWorkbook.Sheets(i).Select
j = ActiveSheet.Name
lastCol = ActiveSheet.Range("I3").Column
lastRow = ActiveSheet.Cells(65536, 1).End(xlUp).Row
ActiveSheet.Range("a3:" & _
ActiveSheet.Cells(lastRow, lastCol).Address).Select
Selection.Copy
Windows("update-test.xlsx").Activate 'pokud bude tento sešit také otevřený
Sheets(j).Select
If Range("A3").Value = "" Then
Range("A3").Select
Else
Range("A2").Select
Selection.End(xlDown).Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next i
End Sub
</code>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