PC-HELP.CZ

České diskuzní fórum o počítačích
https://pc-help.cnews.cz/

Opsání Excelového sešitu

https://pc-help.cnews.cz/viewtopic.php?f=35&t=64773

Stránka 1 z 2

Opsání Excelového sešitu

Napsal: 03 bře 2011 11:18
od omeganet
Ahoj, potřeboval bych poradit jak automaticky opsat definované buňky z jednoho sešitu do druhého.
Jedná se o výkazy elektrické energie, kde se do určených buněk vkládají vstupní hodnoty (adresa, stavy elektroměrů, ceny, apod.)
v dalších listech jsou potom údaje zpracovávaný do měsíčních výkazů, faktur a přehledů.
Problém je v tom, že se občas legislativou změní výstupní formuláře a všechny vstupní hodnoty se musí opsat do nového aktualizovaného sešitu dodaného autorem.
Šlo by to naprogramovat, aby se ze sešitu s názvem Energie1.xls zkopírovaly hodnoty z listu "vstupní údaje", vybrané buňky například: A10, D12, H15……. do sešitu Energie2.xls "vstupní údaje" A10, D12, H15,……….
Celkově je těch kopírovaných buněk přes 100 a dělám to pro několik míst. Takže pokud dojde ke změně je to zbytečná práce na půl den.
Moc děkuji za pomoc
Jirka

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 13:11
od Poki
Zdravim,

Kazda bunka se zkopirovat ze souboru Energie1.xls do souboru Energie2.xls takto:

Kód: Vybrat vše

Worksheets("Energie2.xls").Range("A10") = Worksheets("Energie1.xls").Range("A10")

Pokud by to nebyly jen nahodile bunky, ale bunky v nejake posloupnosti (napr. vsechny bunky ve sloupci A nebo kazda druha bunka ve sloupci A, apod). Nebylo by potreba napsat 100x jiny radek kodu (viz vyse), ale pouzit cyklus - to ale zalezi na konkretnich bunkach...

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 13:40
od navstevnik
To poki:
Worksheets("Energie2.xls").Range("A10") = Worksheets("Energie1.xls").Range("A10")

to myslis vazne?
Kdyz uz,tak pro otevrene sesity takto:

Kód: Vybrat vše

Workbooks("Energie2.xls").Worksheets("vstupní údaje").Range("A10") = Workbooks("Energie1.xls").Worksheets("vstupní údaje").Range("A10")

No a co se tyce ucelenych bloku bunek (napr.: A1:B10), tak pro kopirovani je vhodne pouzit operace s objekty, napr.:

Kód: Vybrat vše

  Workbooks("Energiie2.xls").Worksheets("list1").Range("A1:B10").Value = _
      Workbooks("Energiie1.xls").Worksheets("list1").Range("A1:B10").Value

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 15:04
od Poki
To Navstesvnik: Jajx - tak to byl slusnej ulet :lol:.
Kdyby to byl smile, kterej si sype popel na hlavu, tak uz bude videt jen kupa popela.
Omlouvam se timto OmegaNetovi, snad nestihl udelat chybu podle me skvele odpovedi :).
Pokud jde o to kopirovani, tak nevim, jestli je dobry napad kopirovat cele oblasti hodnot, protoze nevis, co je v ostanich bunkach, jestli je zadouci je kopirovat.

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 18:50
od navstevnik
Pokud je zapotrebi aktualizovat vybrane bunky na stejnych adresach, pak lze pouzit proceduru ve standardnim modulu VBA, treba soubor Energie1:

Kód: Vybrat vše

Option Explicit

Sub Aktualizovat()
  Dim SWsht As Worksheet, TWsht As Worksheet
  Dim TBlk As Range, TCll As Range
  Set SWsht = Workbooks("Energie1.xls").Worksheets("vstupní údaje")
  Set TWsht = Workbooks("Energie2.xls").Worksheets("vstupní údaje")
  ' definovat bunky urcene ke zmene, zapsat vsechny bunky
  Set TBlk = TWsht.Range("a1,a3,a5")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TWsht = Nothing
  Set SWsht = Nothing
End Sub

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 22:50
od omeganet
:D Super tohle funguje bezvadně. Děkuji i ostatním. Měl bych ještě jednu doplňující otázku, jak v tomto scriptu definuji změnu na dalších listech? Jde o číslování dokladů, takže na listu "faktura leden" potřebuji zkopírovat D2,D3 "faktura unor" D2,D3..............

Kód: Vybrat vše

Option Explicit

Sub Aktualizovat()
  Dim SWsht As Worksheet, TWsht As Worksheet
  Dim TBlk As Range, TCll As Range
  Set SWsht = Workbooks("Energie1.xls").Worksheets("Vstupní údaje")
  Set TWsht = Workbooks("Energie2.xls").Worksheets("Vstupní údaje")
  ' definovat bunky urcene ke zmene, zapsat vsechny bunky
  Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n14")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TWsht = Nothing
  Set SWsht = Nothing
End Sub

Re: Opsání Excelového sešitu

Napsal: 03 bře 2011 23:46
od navstevnik
jak v tomto scriptu definuji změnu na dalších listech? Jde o číslování dokladů, takže na listu "faktura leden" potřebuji zkopírovat D2,D3 "faktura unor" D2,D3..............

zkus to upresnit, lepsi ale bude, kdyz pripojis ukazku sesitu Energie1, pripadne Energie2 a vyznacis podbarvenim bunek na dalsich listech, co je potreba zkopirovat.

Re: Opsání Excelového sešitu

Napsal: 04 bře 2011 01:49
od omeganet
Tak zatím jsem to zkoušel takhle:
Ale určitě to půjde napsat i optimalizovaněji. Alespoň by se stále nemusel udávat název sešitů, ty by mohly být někde na začátku a pak už jenom odkazem.
Jinak to už funguje na celý sešit.

Kód: Vybrat vše

Option Explicit

Sub Aktualizovat()

' Vstupní údaje

  Dim SWsht As Worksheet, TWsht As Worksheet
  Dim TBlk As Range, TCll As Range
  Set SWsht = Workbooks("Energie1.xls").Worksheets("Vstupní údaje")
  Set TWsht = Workbooks("Energie2.xls").Worksheets("Vstupní údaje")
  ' definovat bunky urcene ke zmene, zapsat vsechny bunky
  Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TWsht = Nothing
  Set SWsht = Nothing

' čislovani faktur ZB

Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Únor ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Únor ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Březen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Březen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Duben ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Duben ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Květen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Květen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Červen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Červen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Červenec ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Červenec ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Srpen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Srpen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Září ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Září ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Říjen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Říjen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Listopad ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Listopad ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Prosinec ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Prosinec ZB").Range("D2")

' fakturační údaje ZB (v dalších verzích upravit pořadí buněk a doplnit nové)

Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D4") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("A4")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D7") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D6")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D9") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D8")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D10") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D9")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D11") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D10")


' čislovani faktur DE

Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Únor DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Únor DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Březen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Březen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Duben DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Duben DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Květen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Květen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Červen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Červen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Červenec DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Červenec DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Srpen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Srpen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Září DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Září DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Říjen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Říjen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Listopad DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Listopad DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Prosinec DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Prosinec DE").Range("D2")

' fakturační údaje DE (v dalších verzích upravit pořadí buněk a doplnit nové)

Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D4") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("A4")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D7") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D6")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D9") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D8")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D10") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D9")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D11") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D10")


' Výkaz ERU

Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A23") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A23")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F23") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F23")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A24") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A24")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F24") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F24")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A27") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A27")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F27") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F27")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A30") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A30")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("I30") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("I30")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("D89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("D89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("G89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("G89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("I89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("I89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A94") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A94")




' Výkaz OZE

Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("C45") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("C45")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("G47") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("G47")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("F37") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("F37")




' Výkaz OZE

Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("C45") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("C45")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("G47") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("G47")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("F37") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("F37")


End Sub


Re: Opsání Excelového sešitu

Napsal: 04 bře 2011 08:27
od navstevnik
Trochu polidstena procedura je nize. Urcite by se dalo jeste vice zjednodusit, ale dalsi doplnovani by kvuli neprehlednosti bylo komplikovane.
Protoze nemam testovaci soubory, musis overit funkcnost na kopiich souboru a pripadne chyby vychytat, dopln si dalsi potrebne aktualizace.

Kód: Vybrat vše

Option Explicit

Sub Aktualizovat()
  Dim SWbkN As String, TWbkN As String
  Dim SWbk As Workbook, TWbk As Workbook
  Dim SWsht As Worksheet, TWsht As Worksheet
  Dim TBlk As Range, TCll As Range
  Dim i As Integer, SAddrArr As Variant, TAddrArr As Variant

  ' nazvy otevrenych souboru
  SWbkN = "Energie1.xls"
  TWbkN = "Energie2.xls"
  Set SWbk = Workbooks(SWbkN)
  Set TWbk = Workbooks(TWbkN)
  ' Vstupní údaje

  ' listy - uprava na jednom listu, vice bunek
  Set TWsht = TWbk.Worksheets("Vstupní údaje")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll

  ' èislovani faktur ZB

  ' uprava na vice listech, jedna bunka
  ' vykonat
  For Each TWsht In TWbk.Worksheets
    If Left(TWsht.Name, 3) = "Fak" And Right(TWsht.Name, 2) = "ZB" Then
      TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
    End If
  Next TWsht

  ' fakturaèní údaje ZB (v dalších verzích upravit poøadí bunìk a doplnit nové)

  ' uprava na jednom listu, rozdilne bunky zdroj a cil

  Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
  SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
  For i = LBound(TAddrArr) To UBound(SAddrArr)
    TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
  Next i


  ' èislovani faktur DE

  ' vykonat
  For Each TWsht In TWbk.Worksheets
    If Right(TWsht.Name, 2) = "DE" Then
      TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
    End If
  Next TWsht

  ' fakturaèní údaje DE (v dalších verzích upravit poøadí bunìk a doplnit nové)

  Set TWsht = TWbk.Worksheets("Leden DE")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
  SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
  For i = LBound(TAddrArr) To UBound(SAddrArr)
    TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
  Next i

  ' Výkaz ERU

  ' listy
  Set TWsht = TWbk.Worksheets("I. ètvrtletí")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("a23:a24,f23:f24, a27,f27,a30,i30,a89,d89,g89,i89,a94")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll


  ' Výkaz OZE

  ' listy
  Set TWsht = TWbk.Worksheets("Výkaz OZE Leden")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("c45,g47,f37")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll


  ' odstranit objektove promenne
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TWsht = Nothing
  Set SWsht = Nothing
  Set TWbk = Nothing
  Set SWbk = Nothing
End Sub

Re: Opsání Excelového sešitu

Napsal: 04 bře 2011 10:05
od omeganet
Moc děkuji, je to nádhera, když to takhle někdo umí.

Teď jsem to zkoušel krokovat a hází to malou chybu na posledním řádku při vracení se na další hodnotu Next i
budeš vědět?

Kód: Vybrat vše

' uprava na jednom listu, rozdilne bunky zdroj a cil

  Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
  SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
  For i = LBound(TAddrArr) To UBound(SAddrArr)
    TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
  Next i

Re: Opsání Excelového sešitu

Napsal: 04 bře 2011 10:45
od navstevnik
No a jakou chybu to "hazi"?
Nejspis bude potreba upravit kod v radcich:

Kód: Vybrat vše

  For i = LBound(TAddrArr) To UBound(SAddrArr)
    TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)

ve vsech pripadech pouziti teto casti kodu v procedure, zvyraznuji zmenu:
For i = LBound(TAddrArr) To UBound(TAddrArr)
TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
Next i

Re: Opsání Excelového sešitu

Napsal: 04 bře 2011 12:29
od omeganet
Tak, už to funguje celé. Pomohly ty (i) v závorkách

Kód: Vybrat vše

TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))


přikládám finální kód a moc děkuji za pomoc.

Kód: Vybrat vše

Option Explicit

Sub Aktualizovat()
  Dim SWbkN As String, TWbkN As String
  Dim SWbk As Workbook, TWbk As Workbook
  Dim SWsht As Worksheet, TWsht As Worksheet
  Dim TBlk As Range, TCll As Range
  Dim i As Integer, SAddrArr As Variant, TAddrArr As Variant

  ' nazvy otevrenych souboru

  SWbkN = "Energie1.xls"
  TWbkN = "Energie2.xls"
  Set SWbk = Workbooks(SWbkN)
  Set TWbk = Workbooks(TWbkN)

  ' Vstupní údaje

  ' listy - uprava na jednom listu, vice bunek

  Set TWsht = TWbk.Worksheets("Vstupní údaje")
  Set SWsht = SWbk.Worksheets(TWsht.Name)

  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll

  ' čislovani faktur ZB

  ' uprava na vice listech, jedna bunka
  ' vykonat
  For Each TWsht In TWbk.Worksheets
    If Left(TWsht.Name, 3) = "Fak" And Right(TWsht.Name, 2) = "ZB" Then
      TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
    End If
  Next TWsht

  ' fakturační údaje ZB (v dalších verzích upravit pořadí buněk a doplnit nové)

  ' uprava na jednom listu, rozdilne bunky zdroj a cil

  Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  TAddrArr = Array("a4", "c7", "c9", "c10", "c11")
  SAddrArr = Array("a4", "c6", "c8", "c9", "c10")
  For i = LBound(TAddrArr) To UBound(SAddrArr)
  TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
  Next i
 


  ' čislovani faktur DE

  ' vykonat
  For Each TWsht In TWbk.Worksheets
    If Right(TWsht.Name, 2) = "DE" Then
      TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
    End If
  Next TWsht

 
  ' Výkaz ERU

  ' listy
  Set TWsht = TWbk.Worksheets("I. čtvrtletí")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("a23:a24,f23:f24, a27,f27,a30,i30,a89,d89,g89,i89,a94")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll


  ' Výkaz OZE

  ' listy
  Set TWsht = TWbk.Worksheets("Výkaz OZE Leden")
  Set SWsht = SWbk.Worksheets(TWsht.Name)
  ' definovat bunky urcene ke zmene
  Set TBlk = TWsht.Range("c45,g47,f37")
  ' vykonat
  For Each TCll In TBlk.Cells
    TCll.Value = SWsht.Range(TCll.Address).Value
  Next TCll


  ' odstranit objektove promenne
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TWsht = Nothing
  Set SWsht = Nothing
  Set TWbk = Nothing
  Set SWbk = Nothing
End Sub
Časové pásmo: UTC+02:00
Stránka 1 z 2
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/