Ú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,

• #24838 Fferi50 Topikgazda tgumis #24837

  Új Válasz 2015-01-03 22:31:34 #24838

  Ú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

  

  Fferi50

  Topikgazda

  válasz tgumis #24837 üzenetére

  Szia!

  A Munka2 munkalapon keresed az utolsó sort, akkor oda is be kell írni:

  usor = Munka2.Cells(Rows.Count, 1).End(xlUp).Row + 1

  Azután elég ennyi:
  For xx=1 to 5
  Munka2.cells(usor,xx).value=Munka1.Cells(xx+1,2).value
  Next

  Üdv.

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