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

• #20190 Attas aktív tag Delila_1 #20187

  Új Válasz 2014-01-22 15:56:55 #20190

  Ú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

  

  Attas

  aktív tag

  válasz Delila_1 #20187 üzenetére

  Szia Delila!
  Mint már oly sokszor, most is köszönöm a segítséged! Valamiért nem működik. Kicsit átalakítottam, mert azt szeretném, ha a makró tartalmazná a keresési feltételeket. Vagy esetleg a Munk4 A1 és B1 cellája. A makró lefut de nem visz át időadatot.

  Sub Atmasol()
  Dim WS As Worksheet, sor As Long, usor As Long, v$, WF As WorksheetFunction
  Dim oszlop As Integer, sor1 As Long, f As Boolean
  
  Application.ScreenUpdating = False
  
  Set WF = Application.WorksheetFunction
  Sheets("Adatok").Activate
  
  v$ = "C"
  If v$ = "B" Or v$ = "b" Then
  Set WS = Sheets("Munka2")
  oszlop = 2
  v$ = "AF230"
  GoTo Keres
  End If
  
  If v$ = "C" Or v$ = "c" Then
  Set WS = Sheets("Munka1")
  oszlop = 3
  v$ = "AF0230M01SP1-Station2"
  GoTo Keres
  End If
  Exit Sub
  
  Keres:
  usor = WF.CountA(Columns(oszlop))
  f = False
  For sor = 1 To usor
  If Cells(sor, oszlop) = v$ Then
  If WS.Range("C6") = "" Then sor1 = 6 Else sor1 = WS.Range("C" & Rows.Count).End(xlUp).Row + 1
  Cells(sor, "D").Copy WS.Cells(sor1, "C")
  f = True
  End If
  Next
  
  'Rendezés
  WS.Activate
  Range("C6").Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Sort Key1:=Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal
  
  Sheets("Adatok").Activate
  Application.ScreenUpdating = True
  End Sub

  "Az élet olyan mint az ásás. Néha pár gyökér feltart, de annak jól odacsapsz és mehetsz tovább!"

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