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

• #23429 m.zmrzlina senior tag .OM. #23423

  Új Válasz 2014-09-24 12:47:05 #23429

  Ú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

  

  m.zmrzlina

  senior tag

  válasz .OM. #23423 üzenetére

  Próbáld ki ezt! Szerintem közel van ahhoz amit szeretnél. Úgy indítasz, hogy kijelölöd azt a tartományt aminek a szineit másolni szeretnéd és elindítod a makrót.

  Sub masol()
  
  Dim intSorok As Integer
  Dim intOszlopok As Integer
  Dim arrCopyColor()
  
  intSorok = Selection.Rows.Count
  intOszlopok = Selection.Columns.Count
  ReDim arrCopyColor(intSorok, intOszlopok)
  
  For i = 0 To intSorok
  For j = 0 To intOszlopok
  arrCopyColor(i, j) = Cells(ActiveCell.Row + i, ActiveCell.Column + j).DisplayFormat.Interior.Color
  Next
  Next
  
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "colors"
  
  For i = 1 To intSorok
  For j = 1 To intOszlopok
  Cells(i, j).Interior.Color = arrCopyColor(i, j)
  Next
  Next
  
  End Sub

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