- This topic has 19 hozzászólás, 3 résztvevő, and was last updated 5 years, 4 months telt el by
.
-
Szia! Nem az egész fájlt szeretném bemásolni, csak meghatározott oszlopokat. Jelen esetben az „a” oszlopból a személyeket, és a hozzájuk tartozó munkaidőket „r” oszlopból valamint a dátumot. Egymás alá. Ez a művelet havi szinten elvégzendő, minden naphoz két db xlsx fálj tartozik. Én makróra gondoltam. Közepes felhasználói szinten vagyok. A mellékelt fálj mutatja mire gondolok (elnagyolva).
Köszönettel Tibor
Üdv!
Eddig eljutottam, de nem jól működik. Mi lehet a hiba? A másolt adatokat szépen egymás alá kellene folyamatosan írnia, de nem úgy csinálja.Sub Munka1()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim directory As String, fileName As String, sheet As Worksheet
directory = „D:\2019.08\”
fileName = Dir(directory & „*.xlsx”)
Do While fileName <> „”
Workbooks.Open fileName:=directory & fileName, ReadOnly:=True
Range(„A2:E” & ActiveSheet.UsedRange.Rows.Count).Copy Destination = _ wb.Worksheets(„Célmunkalap”).Range(„A” & wb.Worksheets(„Célmunkalap”).UsedRange.Rows.Count + 1)
Windows(„Órák.xlsm”).Activate
Range(„A” & wb.Worksheets(„Célmunkalap”).UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
Workbooks(fileName).Close
fileName = Dir()
Loop
End SubSzia!
Mégis a makró mellett döntöttél? Nem jó döntés, de te tudod 🙂
Te írtad, vagy találtad, és próbálod faragni?
Modjuk leírhattad volna, hogy mit csinál, ahelyett, amit szeretnél.
Teszt adatok nélkül pedig egy csomó időmbe tellene próbálgatni.Tehát tesztelés és debug nélkül első ránézésre a folyamat nem tűnik rossznak, de a következő problémát látom:
Olyan, mintha kétszer próbálná megcsinálni az átmásolástEgyszer van egy Copy parancs, ami utána a Destination-ben mondja meg, hogy hová kellene másolni. (Itt különben a Destination:= kellene, tehát kimaradt egy kettőspont
Aztán lejjebb átvált az „órák” makrófüzetbe és a „Célmunkalap”-ra szintén bemásolná megint.
ha jól látom, akkor a makrós füzetben állva kell elindítani, különben nemlesz jó a működés.
Próbáld meg F8-al lépésenként futtatni és figyelni, hogy mi történik, fogod látni, hogy hol a hiba az algoritmusban. Persze ha elindul.Imre
P.S
ha kódot másolsz a post-ba, akkor miután bemásoltad, jelöld ki, és nyomd meg a formázó gombok közül a code felratot. Ez formázatlan állapotban hagyja, és simán lehet másolni az Excel VBA editorába, nem kell cserélgetni a rossz idézőjeleket jóra, stb…Szia! Kiszedtem a duplázást, szépen dolgozik, csak az a baj, hogy nem egymás alá rakja a másolt adatokat, hanem egymásra, felülírja. Illetve nem tudom miért, de a célmunkalapon az ‘A19’ cellánál kezdi nem pedig az elején.
Sub Munka1() Dim wb As Workbook Set wb = ActiveWorkbook Dim directory As String, fileName As String, sheet As Worksheet directory = "D:\2019.08\" fileName = Dir(directory & "*.xlsx") Do While fileName <> "" Workbooks.Open fileName:=directory & fileName, ReadOnly:=True Range("A2:E" & ActiveSheet.UsedRange.Rows.Count).Copy Destination:=wb.Worksheets("Célmunkalap").Range("A" & wb.Worksheets("Célmunkalap").UsedRange.Rows.Count + 1) Workbooks(fileName).Close False fileName = Dir() Loop End SubNem tudom, hogy érted-e mit csináltál, de a tanácsom az, hogy ezt a usedrange dolgot felejtsd el, nagyon bizonytalanul működik. Ezzel próbálja meg megállapítani, hogy hol van a vége a használt tartománynak.
De például, ha kitörölsz sorokat, attól még azt hiszi, hogy a régi méret a helyes.Elvileg gondolom úgy működik, hogy a célmunkalap első sorában van a fejléc, és az első üres sorba szeretnéd rakatni vele az aktuális darabot.
Próbáld ki ezt kicserélni:
Destination:=wb.Worksheets("Célmunkalap").Range("A" & _ wb.Worksheets("Célmunkalap").Range("A1").Currentregion.Rows.Count + 1)Imre
Feltettem a módosított fájt, benne a hozzá tartozó mesével.
A füzetben rosszul írtam: nem az A:M, hanem az A:N tartomány adja a kimutatás alapját.
Az N oszlop FKERES függvénye az A oszlop ID-je alapján beírja a dolgozó nevét, ez szerepel a kimutatásban.
- Be kell jelentkezni a hozzászóláshoz.
