< návrat zpět

MS Excel


Téma: VBA kopírovat data z jiných sešitů rss

Zaslal/a 2.2.2019 12:12

Zdravím všechny programátory, potřeboval bych pomoct s vytvořením makra, ale nevím, jestli je to možné. O co se jedná. Příklad: měl bych složku "data" a v ní hlavní sešit data.xlsm a další sešity xlsx, např. sešit1.xlsx, sešit2.xlsx, atd. Počet sešitů xlsx je různý. Potřeboval bych, aby v sešitě data.xlsm se ve sloupci A zapsal seznam všech sešitů xlsx a do sloupců B až E se na každý řádek zkopírovaly z List1 údaje z řádků B1 až E1 daného sešitu xlsx. Předem moc děkují alespoň za nějaký nápad.

Zaslat odpověď >

#042628
MePExG
Musí to byť VBA? ..., lebo PQ to zvládne hravo.citovat
#042629
avatar
byl bych radší, kdyby to bylo ve VBA, pokud to nějak jde.citovat
#042630
Stalker
Možný příklad řešení. Soubor "data" nemusí být ve stejné složce jako soubory ze kterých chceme data čerpat. Při spuštění je zobrazen dialog pro výběr sešitů.
Příloha: zip42630_wall.zip (44kB, staženo 32x)
citovat
#042631
avatar
Není to úplně přesné jak jsem si představoval, ale takto mi to stačí. Děkují moccitovat
#042633
elninoslov
Alebo aj niečo podobné:
Sub SouhrnDat2()
Dim D() As String, Soubory() As String, Soubor As String, Cesta As String, Pocet As Long

Cesta = ThisWorkbook.Path & "\"
Soubor = Dir(Cesta & "*.xlsx", vbHidden)
While Soubor <> ""
Pocet = Pocet + 1
ReDim Preserve Soubory(1 To Pocet)
Soubory(Pocet) = Soubor

ReDim Preserve D(1 To Pocet)
D(Pocet) = "='" & Cesta & "[" & Soubor & "]List1'!B$1"
Soubor = Dir()
Wend

If Pocet > 0 Then
With List1.Cells(2, 1).Resize(Pocet)
.Value = Application.Transpose(Soubory)
With .Offset(0, 1).Resize(Pocet, 4)
.Formula = Application.Transpose(D)
.Value = .Value
End With
End With
End If
End Sub
citovat
#042641
avatar
Tak to je přesně tak, jak jsem si to představoval. Moc děkují oběma za strávený čas. Jste pašáci. 1citovat
#042642
avatar
Tak to je přesně tak, jak jsem si to představoval. Moc děkují oběma za strávený čas. Jste pašáci. 1citovat
#042643
elninoslov
Je viac možností. Ak by sa napríklad nevolal list v tých súboroch rovnako, dá sa cez ADO zistiť názov listu bez otvorenia súboru. Ale to už je otázka, či potom neprečítať rovno aj hodnoty cez ADO.

Ak sa ale volajú listy rovnako, tak vyššie uvedené bude asi najrýchlejšie riešenie.

PQ nezavrhujte, dajú sa tam robiť psie kusy, a zrovna mepexg je macher. Navyše nemusia byť povolené makrá (firemná fóbia).citovat
#042644
avatar
PQ nezavrhují, jen jsem o něm nevěděl. Takže vůbec nevím, co vše umí. A věřím tomu, že všichni, co tu nějak vypomůžou, tak jsou machři. Já před nimi jen smekám.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

On-line nástroje