Új hozzászólás Aktív témák

• alfa20 senior tag

  #2884

  #2883 xml2

  2017-08-26 00:00:07

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  alfa20

  senior tag

  #2883 xml2

  #2883 xml2

  Sziasztok!
  Excel makró témában szeretnék segítséget kérni.

  Van 4db munkalapom: Alap, Összefűz, Kiegészít, Kész
  Minden cella szöveget tartalmaz.
  Az Alap munkalapon csak az A oszlopban vannak adatok.
  Az Összefűz lapon az A1 és az A3 cella foglalt (fix), az A2-be (változó) kellene másolni az Alap lapról a tartalmat, cellánként.
  Beillesztés után a 3 cellát összefűzni (szóköz nélkül) egy új cellába, majd ezt az új tartalmat továbbküldeni a Kész munkalap A oszlopába, az első üres cellába.
  Mindezt addig kellene csinálni (az Összefűz lap A2 celláját felülírva az új tartalommal), ameddig az Alap munkalap A oszlopában üres cellához nem ér.
  Ha ez megtörtént, a Kiegészít munkalap A1-A16 cellákat kellene bemásolni a Kész munkalap következő, A oszlopban lévő, üres celláiba.

  Nagyon szépen köszönöm, ha valaki lesz olyan kedves, és szán rá egy kis időt, energiát, hogy kisegítsen!

  Szerk: fontos lehet, Office 2010 Prof. Plus, amivel rendelkezem.

  Szia!

  Én így oldanám meg, viszont a Do While-ban lévő első két sort én elhagynám, az ha nincs miértje, szerintem felesleges. Illetve a "3 cellát összefűzni (szóköz nélkül)" arra utalt, hogy a cellák közt ne legyen szünet vagy a tartalmukban?
  Ha a tartalmukban, akkor vedd ki a kommentet a ' szóköz eltávolítása:

  Sub main()

Application.ScreenUpdating = False

Dim usorKesz, alapSor As Long
usorKesz = Sheets("Kész").Range("A" & Rows.Count).End(xlUp).Row
alapSor = 1

Sheets("Alap").Select

Do While (Cells(alapSor, 1) <> "")
Cells(alapSor, 1).Copy
Sheets("Összefűz").Range("A2").PasteSpecial
Sheets("Kész").Cells(usorKesz + alapSor, 1) = Sheets("Összefűz").Range("A1") & _
Sheets("Összefűz").Range("A2") & Sheets("Összefűz").Range("A3")
' szóköz eltávolítása:
'Sheets("Kész").Cells(usorKesz + alapSor, 1).Replace What:=" ", Replacement:=""
alapSor = alapSor + 1
Loop

Sheets("Kiegészít").Range("A1:A16").Copy
Sheets("Kész").Range("A" & usorKesz + alapSor).PasteSpecial

Application.ScreenUpdating = True

End Sub

  erre gondoltál?

Új hozzászólás Aktív témák