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

• #22168 slashing senior tag

  Új Válasz 2014-06-27 22:22:15 #22168

  Ú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

  

  slashing

  senior tag

  Szép lassan összelopkodom innen onnan ami kell de most kicsit megakadtam.
  Ez a makró jelenleg azt csinálj hogy az A3:A1000 tartományban megkeresni a nem üres cellákat, kijelöli azokat majd átmásolja a Mega lapra transzponálva.
  Na most én azt szeretném hogy ne a mega lapra másolja hanem a mega.xlsx-be és oda is úgy kellene hogy mindig az első üres sorba egymás alá. Ez azért fontos mert a két hozzászólással feljebb lévő minden munkafüzeten lefutó makróba kell majd ezt bele applikálnom(a hello world helyére). Szóval a végén a Mega.xlsb-ben elvileg annyi sorban lesznek adatok ahány munkafüzet van az adott könyvtárban ahol le fog futni a makró.

  Sub it()

  Dim cell As Range
  Dim selectRange As Range

  For Each cell In ActiveSheet.Range("A3:a1000")
  If (cell.Value <> "") Then
  If selectRange Is Nothing Then
  Set selectRange = cell
  Else
  Set selectRange = Union(cell, selectRange)
  End If
  End If
  Next cell

  selectRange.Select
  Selection.Copy
  Sheets("mega").Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
  False, Transpose:=True
  End Sub

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