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

• #24855 Mutt senior tag tgumis #24837

  Új Válasz 2015-01-04 20:33:12 #24855

  Ú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

  

  Mutt

  senior tag

  válasz tgumis #24837 üzenetére

  Hello,

  Ha csak akkor induljon a másolás, ha mindegyik másolandó cella ki van jelölve, akkor ezt próbáld ki:

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Const rngKijelol = "B2:B6" 'ebből a tarományból másolunk
  Const wsCel = "Sheet2" 'erre a munkalapra másolunk
  Dim rngMasolando As Range
  Dim vSor As Long 'a cél munkalap utolsó sora
  Dim arryAdatok As Variant
  
  'megnézzük hogy ami ki van jelölve az mennyire fedi a másolandó tartományt
  Set rngMasolando = Application.Intersect(Range(Target.Address), Range(rngKijelol))
  
  'ha van fedés és az teljes, akkor mehet az utolsó sor meghatározása és az inverz másolás
  If Not rngMasolando Is Nothing Then
  If rngMasolando.Address = Range(rngKijelol).Address Then
  vSor = Worksheets(wsCel).Range("A" & Rows.Count).End(xlUp).Row + 1
  arryAdatok = rngMasolando.Value
  Worksheets(wsCel).Range("A" & vSor).Resize(, rngMasolando.Rows.Count) = Application.Transpose(arryAdatok)
  End If
  End If
  End Sub

  Az elején vannak változók amiket igényszerint módosíts. Ahhoz a laphoz kell a kódot bemásolni ahonnan történik a másolás.

  üdv,

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