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

• #29758 Delila_1 veterán Zimmy88 #29753

  Új Válasz 2015-12-08 17:29:39 #29758

  Ú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

  

  Delila_1

  veterán

  válasz Zimmy88 #29753 üzenetére

  Most gyorsabb lesz. Folytatnod kell az elso = 8: ucso = 9: GoSub Atir típusú sorokat.
  Az oszlopok törlése részbe a saját törlendő oszlopaidat írd be.

  Sub mm()
  Dim lap As Integer, nev As String, utvonal As String
  Dim elso As Long, ucso As Long
  utvonal = "D:\kiment\"
  
  For lap = 1 To Worksheets.Count
  If Sheets(lap).Range("B1") = "ez kell" Then
  Sheets(lap).Select
  
  elso = 8: ucso = 9: GoSub Atir
  elso = 12: ucso = 14: GoSub Atir
  elso = 16: ucso = 17: GoSub Atir
  elso = 20: ucso = 22: GoSub Atir
  '*** stb ***
  
  'oszlopok törlése
  Range("B:D,F:F").Delete Shift:=xlToLeft
  
  nev = ActiveSheet.Name
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs Filename:=utvonal & nev & ".xlsx"
  ActiveWindow.Close
  End If
  Next
  Exit Sub
  
  Atir:
  Range("E" & elso & ":W" & ucso).Copy
  Range("E" & elso).PasteSpecial xlPasteValues
  Return
  
  End Sub

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