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

• #22171 Delila_1 veterán slashing #22169

  Új Válasz 2014-06-28 07:32:49 #22171

  Ú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 slashing #22169 üzenetére

  [Sub it()
  Dim cell As Range, usor As Long
  Dim selectRange As Range
  
  usor = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
  For Each cell In ActiveSheet.Range("A3:A" & usor)
  If (cell.Value <> "") Then
  If selectRange Is Nothing Then
  Set selectRange = cell
  Else
  Set selectRange = Union(cell, selectRange)
  End If
  End If
  Next cell
  
  usor = Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
  selectRange.Copy
  Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  End Sub

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