Excel - makro

[Tomek001]

Ahojte,
nebudu zdržovat, tudíž krátce.
Mám dílčí excelovské soubory označené jako Vzorek 1-3.xlsx. V každém z nich je na daném listu v dané buňce jeden parametr (ten je vždy umístěn na stejném místě v každém sešitě). Velice by mi pomohlo, kdyby mi tady někdo napsal konkrétní makro, které by kopírovalo data z označených "zažlutěných" buněk ze sešitů Vzorek 1-3.xlsx do jednoho sešitu Master.xlsx (zase do vyznačených žlutých oblastí).
S makry skoro neumím, takže prosím polopatisticky.
Všechny výše zmíněné excelovské soubory jsou zararované v příloze.

Moc děkuji!

[Reklama]

[cmuch]

Pokud budou ty tři sešity pořád na stejném místě, lze ty hodnoty tam dostat i pomocí propojení.
např: ='C:\cesta\[sešit2.xlsx]List1'!$B$3 (hodnota ze sešitu 2 a buňky B3)

[Tomek001]

Děkuji za radu cmuchu,
nicméně mám těch sešitů i listů ve skutečností mnohem více než v tomto modelovém příkladě - a nové data stále přibývají. Tudíž to už považuju za pracné a z tohoto důvodu bych to rád (propojoval, kopíroval) pomocí makra.

[cmuch]

Tak toto chtělo též uvést již na začátku

mám těch sešitů i listů ve skutečností mnohem více než v tomto modelovém příkladě - a nové data stále přibývají

Pokud toto nepopíšeš přesněji tak makro sice tady někdo vymyslí na ten tvůj model, ale věřím, že na to co ho ve skutečnosti potřebuješ již fungovat nebude.

Takže
Kde budou všechny sešity, budou ve stejné složce?
Co názvy listů, budou stejné ve všech sešitech?
Data co se mají kopírovat, budou ve stejných buňkách ve všech sešitech?
....

[Tomek001]

Jasně, není problém, klidně se ptej - popíšu.
Co se týče Tvých výše uvedených dotazů, tak všude je odpověď ano:
1) Všechny sešity se mohou nacházet (a nacházejí pro zjednodušení) v jedné složce.
2+3) Jak názvy listů, tak rozmístění kopírovaných buňěk jsou ve všech sešitech ze kterých potřebuju tahat data, STEJNÉ - je to pro zjednodušení vše z jedné šablony.

Nevím, co všechno by Tě ještě zajímalo, rád zodpovím další upřesňující dotazy :-)

[Tomek001]

Tak mám to makro :-)

Kód: Vybrat vše

Sub LoadData()
    Dim aRange As Range
    Dim aIndex As Integer
    Dim aOpened As Boolean
    Dim aFilename As String
    Dim aWorkbook As Workbook
   
    Set aRange = Range("C3:E5")
    For aIndex = 1 To aRange.Rows.Count
        aFilename = "Vzorek " & aIndex & ".xlsx"
        On Error Resume Next
        Set aWorkbook = Workbooks(aFilename)
        On Error GoTo 0
        If aWorkbook Is Nothing Then
            Set aWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & aFilename)
            aOpened = True
        End If
        aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Povrch").Range("B5")
        aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Objem").Range("C5")
        aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Poloměr").Range("D5")
        If aOpened Then
            aWorkbook.Close False
            aOpened = False
        End If
        Set aWorkbook = Nothing
    Next aIndex
End Sub

Teď jsem ale zjistil, že ve složce se mohou vyskytovat i jiné názvy souborů než Vzorek 1-3.xlsx (samozřejmě se stejnou strukturou buněk). Je možné to makro upravit tak, aby kopírovalo data bez ohledu na název souboru (tedy aby bralo všechny xlsx soubory)?

[cmuch]

Koukám, že už tu makro máš.

Tady je jiné a řeší i různé názvy souborů.
Spouští se samo po změně ve sl.B (hodnota v bunce je i nazev sesitu)
Nakopíruj do modulu listu Parametry.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

Dim AktWbNm As Variant
Dim RowNmWB As Long
Dim Response As Byte
Dim fso, WBOpen As Object
Dim File As String

  ' Proved kdyz je zmena ve sloupci, 1=A
  If Target.Column = 2 Then
 
    Set fso = CreateObject("Scripting.FileSystemObject")

    File = ThisWorkbook.Path & "\" & Target.Value & ".xlsx"
    ' existuje soubor?
    If (fso.FileExists(File)) Then
     
       RowNmWB = Target.Row
       AktWbNm = ThisWorkbook.Name
       Set WBOpen = Workbooks.Open(File)
       
       Application.EnableEvents = False
       Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("C" & RowNmWB).Value = WBOpen.Worksheets("Povrch").Range("B5")
       Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("D" & RowNmWB).Value = WBOpen.Worksheets("Objem").Range("C5")
       Workbooks(AktWbNm).Sheets("PARAMETRY 1").Range("E" & RowNmWB).Value = WBOpen.Worksheets("Poloměr").Range("D5")
       Application.EnableEvents = True
       
       WBOpen.Close False
      Else
       Response = MsgBox("Soubor " & Target.Value & " nenalezen !! ", vbCritical)
    End If
  End If

  Set fso = Nothing
  Set WBOpen = Nothing
End Sub

[Tomek001]

Tak to je paráda!!! Nemusím přejmenovávat soubory a celkově se mi tenhle postup zdá být lepším! :) Moc Ti děkuju :-)

--- Doplnění předchozího příspěvku (31 Bře 2013 23:04) ---

Mohu ještě jednu věc? Ve stejné buňce (A48) v každém sešitě je umístěn text - např, RFA. Lze název sešitu pojmenovat podle toho co je v této buňce umístěno? Nějak hromadně? Dle makra? Sešitů je přes 70.

[cmuch]

Tady v sešitě je makro pro přejmenování souboru dle hodnoty v buňce na listu.

[Tomek001]

Je to super, ale přejmenované sešity sice jdou otevřít, ale nic neobsahují - listy, nic (byť velikost mají srovnatelnou s původními) a nedá se v nich nic dělat

[cmuch]

Hmm,
změnil jsem otevření sešitu z GetObjekt na Workbooks.Open

Upravena příloha předchozí.

[Tomek001]

Funguje to!! Díky!

Jen ještě jedna věc (omlouvám se, že stále otravuju).

Mám následující kod:

Kód: Vybrat vše

Sub NačteVŠECHNAdataVadresari()
    Dim aRange As Range
    Dim aIndex As Integer
    Dim aOpened As Boolean
    Dim aFilename As String
    Dim aWorkbook As Workbook
   
    Set aRange = Range("G3:AG100")
    For aIndex = 1 To aRange.Rows.Count
        aFilename = "RUN_" & aIndex & ".xlsm"
        On Error Resume Next
        Set aWorkbook = Workbooks(aFilename)
        On Error GoTo 0
        If aWorkbook Is Nothing Then
            Set aWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & aFilename)
            aOpened = True
        End If
        aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("B9")
        aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Langmuir").Range("N26")
        aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Langmuir").Range("N33")
        aRange.Cells(aIndex, 4).Value = aWorkbook.Worksheets("DR and Medek").Range("P34")
        aRange.Cells(aIndex, 5).Value = aWorkbook.Worksheets("DR and Medek").Range("P27")
        aRange.Cells(aIndex, 6).Value = aWorkbook.Worksheets("DR and Medek").Range("Z27")
        aRange.Cells(aIndex, 7).Value = aWorkbook.Worksheets("Micropores distribution").Range("N29")
        aRange.Cells(aIndex, 8).Value = aWorkbook.Worksheets("Micropores distribution").Range("N36")
       
        aRange.Cells(aIndex, 9).Value = aWorkbook.Worksheets("Langmuir").Range("N27")
        aRange.Cells(aIndex, 10).Value = aWorkbook.Worksheets("Langmuir").Range("N34")
        aRange.Cells(aIndex, 11).Value = aWorkbook.Worksheets("DR and Medek").Range("P35")
        aRange.Cells(aIndex, 12).Value = aWorkbook.Worksheets("DR and Medek").Range("P28")
        aRange.Cells(aIndex, 13).Value = aWorkbook.Worksheets("DR and Medek").Range("Z28")
        aRange.Cells(aIndex, 14).Value = aWorkbook.Worksheets("Micropores distribution").Range("N30")
        aRange.Cells(aIndex, 15).Value = aWorkbook.Worksheets("Micropores distribution").Range("N37")
       
        aRange.Cells(aIndex, 16).Value = aWorkbook.Worksheets("Langmuir").Range("N28")
        aRange.Cells(aIndex, 17).Value = aWorkbook.Worksheets("Langmuir").Range("N35")
        aRange.Cells(aIndex, 18).Value = aWorkbook.Worksheets("DR and Medek").Range("P36")
        aRange.Cells(aIndex, 19).Value = aWorkbook.Worksheets("DR and Medek").Range("P29")
        aRange.Cells(aIndex, 20).Value = aWorkbook.Worksheets("DR and Medek").Range("Z29")
        aRange.Cells(aIndex, 21).Value = aWorkbook.Worksheets("Micropores distribution").Range("N31")
        aRange.Cells(aIndex, 22).Value = aWorkbook.Worksheets("Micropores distribution").Range("N38")
        If aOpened Then
            aWorkbook.Close False
            aOpened = False
        End If
        Set aWorkbook = Nothing
    Next aIndex
End Sub



1) Jak upravit výše uvedené makro, aby se načítaly všechny xlsm soubory bez ohledu na jejich název - ve složce mám tedy spoustu souborů s různými názvy. Řečený kod je umístěn v xlsm souboru s nazvem MASTER, který kolektuje data ze souborů RUN_1-100 které mají vždy stejnou strukturu (označení souborů jako RUN_se bohužel neosvědčilo) Podle mě by stačilo nějak upravit:

Kód: Vybrat vše

aFilename = "[b]RUN_"[/b] & aIndex & ".xlsm"

2) Už umím pomocí makra importovat hodnoty z buňěk - např. použitím:

Kód: Vybrat vše

aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("B9")

Ale jak postupovat při importování hodnoty z formuláře?

Zkoušel jsem výše uvedený úryvek upravit na:

Kód: Vybrat vše

aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Conditions").Range("[b]skupina 124"[/b])

ale nefunguje to :(