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

• #16924 Excelbarat tag Bocimaster #16918

  Új Válasz 2013-02-25 18:23:25 #16924

  Ú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

  

  Excelbarat

  tag

  válasz Bocimaster #16918 üzenetére

  Ez megoldja a problémád:

  Sub masolo()
  Application.ScreenUpdating = False 'kikapcsolja a képfrissítést így gyorsabb
  Sheets.Add.Name = "Összes" 'beszúr egy összes nevű lapot
  For i = 1 To ActiveWorkbook.Worksheets.Count
  Sheets(i).Select
  If Sheets(i).Name = "Összes" Then 'ha a lap neve összes akkor ugrik a következőre
  Else
  Range(Rows(4), Rows(19)).Copy 'kijelöli a 4-től 19-ig a sorokat
  Sheets("Összes").Select 'átvált az összes lapra
  u = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 'megkeresi az összes lapon az utolsó sort
  Cells(u, "A").Select
  Selection.PasteSpecial Paste:=xlPasteValues 'bemásolja
  End If
  Next i
  Application.ScreenUpdating = True 'visszakapcsolja a képfrissítést
  End Sub

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