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

• #2886 alfa20 senior tag xml2 #2885

  Új Válasz 2017-08-26 10:57:16 #2886

  Ú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

  Privát üzenet küldése

  

  alfa20

  senior tag

  válasz xml2 #2885 üzenetére

  Ha törölni szeretnéd a tartalmat, másképp oldalán meg, a while ciklust módosítanám
  , úgy hogy amit kimásolt azt törölje és addig menjen a ciklus míg a cella tartalma nem üres, de most telóról vagyok, majd délután átírom.

• #2884 alfa20 senior tag xml2 #2883

  Új Válasz 2017-08-26 00:00:07 #2884

  Ú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

  Privát üzenet küldése

  

  alfa20

  senior tag

  válasz xml2 #2883 üzenetére

  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