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

• #16627 Excelbarat tag Attas #16625

  Új Válasz 2013-02-08 12:58:45 #16627

  Ú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 Attas #16625 üzenetére

  Hi itt egy:

  Sub kereso()
  Dim acts, lapnev, ufelt, vfelt, wfelt As String
  Dim lastRow As Long
  
  acts = ActiveSheet.Name
  lapnev = InputBox("Mi legyen az új munkalap neve?", "Lapnév")
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = lapnev
  
  ufelt = InputBox("U oszlop feltétele:", "Feltételmegadás")
  vfelt = InputBox("V oszlop feltétele:", "Feltételmegadás")
  wfelt = InputBox("W oszlop feltétele:", "Feltételmegadás")
  
  Sheets(acts).Select
  i = 1
  Do Until Cells(i, 21).Value = ""
  
  If Cells(i, 21).Value = ufelt And Cells(i, 22).Value = vfelt And Cells(i, 23).Value = wfelt Then
  Range(Cells(i, 1), Cells(i, 23)).Copy
  Sheets(lapnev).Select
  If Range("A1") = "" Then
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Else
  lastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
  Cells(lastRow, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  End If
  
  Sheets(acts).Select
  End If
  i = i + 1
  Loop
  Sheets(lapnev).Select
  Range("A1").Select
  Application.CutCopyMode = False
  End Sub

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