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

• alfa20 senior tag

  #2887

  #2886 alfa20

  2017-08-26 17:42:04

  Ú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

  #2886 alfa20

  #2886 alfa20

  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.

  nézd meg ezt:

  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(1, 1) <> "")
Cells(1, 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")
alapSor = alapSor + 1
Sheets("Alap").Cells(1, 1).Delete
Loop

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

Application.ScreenUpdating = True

End Sub

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