Telefonszámunk: 1-472-0679

[Resolved] Munkalapok adott celláinak másolása

Kezdőlap › Fórumok › Excel programozás › [Resolved] Munkalapok adott celláinak másolása

Topic Resolution: Resolved
17 bejegyzés megtekintése - 1-17 / 17
  • Szerző
    Bejegyzés
  • 2018-12-06-16:23 #5353
    DoWtHen
    Felhasználó

      Sziasztok!
      Segítséget szeretnék kérni egy makróhoz.
      Egy munkafüzet 11.lapjától az utolsóig kellene kimásolnom cellatartományokat egy másik munkalapra.
      A kimásolás részét megcsináltam, és az jól működik, de nem tudom ciklusba rakni, hogy végig menjen az összes munkalapon (kivéve az első 10-en).
      A válaszokat előre is köszönöm.

      Sub Adat_Masolas2()
'ezt kellene minden munkalapon végrehajtania.

Dim oszlop1 As Range
Dim oszlop2 As Range
Dim oszlop3 As Range
Dim oszlop4 As Range
Dim oszlop5 As Range
Dim oszlop6 As Range

Set oszlop1 = Range("D93:E102,L93:M102,T93:U102")
Set oszlop2 = Range("D123:E132,L123:M132,T123:U132")
Set oszlop3 = Range("D153:E162,L153:M162,T153:U162")
Set oszlop4 = Range("D183:E192,L183:M192,T183:U192")
Set oszlop5 = Range("D213:E222,L213:M222,T213:U222")
Set oszlop6 = Range("D243:E252,L243:M252,T243:U252")

    Union(oszlop1, oszlop2, oszlop3, oszlop4, oszlop5, oszlop6).Select
    Selection.Copy
    Sheets("Állásidők_rögzítése").Select
    'Range("B3").Select
    ActiveCell.Select
    ActiveSheet.Paste
    ActiveCell.Offset(60, 0).Activate
End Sub
      2018-12-06-16:28 #5354
      delila
      Felhasználó

        Szia!

        Tedd egy ciklusba.

        For lap=10 to sheets.count
   with sheets(lap)
      set oszlop1 = .Range("D93:E102,L93:M102,T93:U102")
      ...
   end with
next
        2018-12-06-16:37 #5355
        DoWtHen
        Felhasználó

          próbáltam de most is hibás lett, valamit elrontok.

          Attachments:
          You must be logged in to view attached files.
          2018-12-06-16:38 #5357
          DoWtHen
          Felhasználó

            Ezt a sort jelöli:
            ActiveSheet.Paste

            2018-12-06-16:46 #5358
            delila
            Felhasználó

              Az értékadások után 1 lépésben másolhatsz.

              Union(oszlop1, oszlop2, oszlop3, oszlop4, oszlop5, oszlop6).Copy Sheets("Állásidők_rögzítése").Range("B3")

              A másolás helyét (másik lap B3 cella) megjegyzésbe tetted.
              Nem próbáltam ki, de valószínűleg nem szereti a több tartomány együttes beillesztését.
              Ebben az esetben Terület1.Copy MásikLap.Range(cellacím)

              2018-12-06-17:44 #5359
              DoWtHen
              Felhasználó

                Ez most nem csinál semmit, így kellet beilleszteni?

                „Ebben az esetben Terület1.Copy MásikLap.Range(cellacím)” Ezt hogy kell beírni, ennyire nem értek a makróhoz.
                Köszi a válaszokat.

                Sub kigyűjt22()

Dim oszlop1 As Range
Dim oszlop2 As Range
Dim oszlop3 As Range
Dim oszlop4 As Range
Dim oszlop5 As Range
Dim oszlop6 As Range

Set oszlop1 = Range("D93:E102,L93:M102,T93:U102")
Set oszlop2 = Range("D123:E132,L123:M132,T123:U132")
Set oszlop3 = Range("D153:E162,L153:M162,T153:U162")
Set oszlop4 = Range("D183:E192,L183:M192,T183:U192")
Set oszlop5 = Range("D213:E222,L213:M222,T213:U222")
Set oszlop6 = Range("D243:E252,L243:M252,T243:U252")

For lap = 10 To Sheets.Count
   With Sheets(lap)
Union(oszlop1, oszlop2, oszlop3, oszlop4, oszlop5, oszlop6).Copy Sheets("Állásidők_rögzítése").Range("B3")
    End With
    Next
End Sub
                2018-12-06-18:41 #5360
                DoWtHen
                Felhasználó

                  Ezt is kipróbáltam és nem csinál semmit, hibát sem ír ki.

                  Sub kigyűjt33()

For lap = 10 To Sheets.Count
   With Sheets(lap)
Range("D93:E102,L93:M102,T93:U102,D123:E132,L123:M132,T123:U132,D153:E162,L153:M162,T153:U162,D183:E192,L183:M192,T183:U192,D213:E222,L213:M222,T213:U222,D243:E252,L243:M252,T243:U252").Copy Sheets("Állásidők_rögzítése").Range("B3")
    End With
    Next
End Sub
                  2018-12-06-21:42 #5361
                  horvimi
                  Adminisztrátor

                    Sziasztok!

                    Ha jól értem, akkor a 11. laptól a végéig minden lapon ugyanazt a ne összefüggő tartományrendszert akarod kiválasztani, és beilleszteni a gyűjtő lapra, gondolom egymás alá.

                    Ha ezt jól gondolom, akkor
                    – a beillesztés helye nem lehet mindig a B3, hanem a B oszlop első üres cellája.
                    – Ha egy menetben működött, akkor ciklusban is működnie kell.
                    – Szerintem hagyjuk a With .. End With szerkezetet, mert magyarázat nélkül nem érted, hogy hogy működik.
                    – A ciklusban inkább legyen benne az aktuális lap .Select

                    For lap = 10 To Sheets.Count
       Sheets(lap).Select
       Ide a sok Set egymás alá       
       union(....).copy destination:=sheets("gyujto").range("B3").End(xlDown).offset(1,0)
Next

                    Ez akkor lehet jó, ha a bemásoláskor a B oszlopban mindig van adat.

                    Imre

                    • A hozzászólás módosításra került: 5 years, 4 months telt el-horvimi.
                    • A hozzászólás módosításra került: 5 years, 4 months telt el-horvimi.
                    • A hozzászólás módosításra került: 5 years, 4 months telt el-horvimi.
                    • A hozzászólás módosításra került: 5 years, 4 months telt el-horvimi.
                    • A hozzászólás módosításra került: 5 years, 4 months telt el-horvimi.
                    2018-12-07-14:27 #5367
                    DoWtHen
                    Felhasználó

                      Sziasztok.

                      Sub kigyujt3()
Dim oszlop1 As Range
Dim oszlop2 As Range
Dim oszlop3 As Range
Dim oszlop4 As Range
Dim oszlop5 As Range
Dim oszlop6 As Range

For lap = 11 To Sheets.Count
    Sheets(lap).Select
    Set oszlop1 = Range("D93:E102,L93:M102,T93:U102")
    Set oszlop2 = Range("D123:E132,L123:M132,T123:U132")
    Set oszlop3 = Range("D153:E162,L153:M162,T153:U162")
    Set oszlop4 = Range("D183:E192,L183:M192,T183:U192")
    Set oszlop5 = Range("D213:E222,L213:M222,T213:U222")
    Set oszlop6 = Range("D243:E252,L243:M252,T243:U252")
    Union(oszlop1, oszlop2, oszlop3, oszlop4, oszlop5, oszlop6).Copy Destination:=Sheets("Állásidők_rögzítése").Range("B3").End(xlDown).Offset(1, 0)
Next
End Sub

                      Hibát jelez az Union(..).copy sorra.

                      Run-time error ‘1004’: Application-defined or object-defined error

                      2018-12-07-14:37 #5368
                      DoWtHen
                      Felhasználó

                        „Ez akkor lehet jó, ha a bemásoláskor a B oszlopban mindig van adat.” Így is kipróbáltam írtam egy sort a táblába és működik a makró, de a 10 cellapár helyett csak az első cellapárokat másolja át a többit nem.

                        2018-12-07-15:08 #5369
                        horvimi
                        Adminisztrátor

                          Tölts fel egy mintafájlt, ami életszerű.
                          ha szupertitkos, akkor másítsd meg az adatokat.

                          További látatlan gyógyításra nem vállalkozom 🙂

                          2018-12-07-15:26 #5372
                          DoWtHen
                          Felhasználó

                            3 lap maradt meg, a többit törölni kellet a méret miatt.

                            Attachments:
                            You must be logged in to view attached files.
                            2018-12-07-16:20 #5374
                            horvimi
                            Adminisztrátor

                              Ha a wk… lapokon az egyes blokkok ki vannak töltve teljesen, akkor most jól működik.
                              ha viszont a D oszlopban vannak üresek (ezek kerülnek a másolás után a gyűjtő lap B oszlopába), akkor baj lehet.
                              Ugyanis azt, hogy a ciklus következő lapjáról a gyűjtő B oszlopában hol van az utolsó adat, azt most egy B oszlopra indított Ctrl-Lenyíl kódjával próbálom megállapítani.
                              Ezt most neked kellene átgondolni, hogy mivel lehetne jelezni a gyűjtőlapon a bemásolt adatok végét.

                              csináltam egy külön modult, (Module1) ami ezen a fájlon dolgozik.
                              Az első wk lap blokkjait kitöltöttem, a többit nem.

                              Közben lett egy ötletem.
                              ha jól látom, egy blokk 10 soros fixen, tehát egy munkalapon 60 sor van, amit át kell másolni.
                              Ezzel már lehet valamit kezdeni.

                              Szerintem most jó lesz, és nem is kell a kitöltésnek folyamatosnak lenni, ezzel a 60-as bulival megy.
                              Szóval Module1.

                              Imre

                              Attachments:
                              You must be logged in to view attached files.
                              2018-12-07-16:43 #5376
                              DoWtHen
                              Felhasználó

                                Soha nem volt még tele a 10 sor, viszont igen minden lapon fix 10 cella hosszú ez a rész és 60 sort kellene átmásolni.
                                A próba lapon tökéletesen megy, az éles munkafüzetben az átmásolás B363 cellától kezdődik!!!

                                2018-12-07-16:55 #5377
                                horvimi
                                Adminisztrátor

                                  No, hat akkor hajrá, csak a ciklus for részét es a beillesztes elotti sorban levo B3 at kell modositanod.
                                  Jelezd, higy mi lett.

                                  2018-12-07-17:13 #5378
                                  DoWtHen
                                  Felhasználó

                                    Basszus nem írtam át a kezdő lap számát.
                                    Tökéletesem megy NAGYON KÖSZÖNÖM A SEGÍTSÉGET!!!!

                                    2018-12-07-19:25 #5382
                                    horvimi
                                    Adminisztrátor

                                      Nagyon örülök.

                                    • Szerző
                                      Bejegyzés
                                    17 bejegyzés megtekintése - 1-17 / 17
                                    • Be kell jelentkezni a hozzászóláshoz.