Ekteki örnek dosyamda veri girişi sayfasından a1 hücresinden metin girdiğim zaman a4 sayfasında c19 hücresinde satır açılması oluyor. Benim istediğim aynı makronun içerisine veri girişi sayfasından a2,a3,a4,a5,a6 hücrelerinede veri girdiğimde yine a4 sayfasında c26,c29,c30,c31,c32 satırlarındada aynı satır açılması olmasıdır.Eğer veri girişinde a1,a2,a3,a4,a5,a6 hücrelerine veri girilmediği zaman ise a4 sayfasında veri girilmeyen satırlar gizlenebilir mi ?
Sub deneme_MTK()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Worksheets("a4").Activate
Range("c19").Select
ActiveCell.EntireRow.AutoFit
If ActiveCell.Value = Empty Then
ActiveCell.EntireRow.AutoFit
Else
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Worksheets("VERİ GİRİŞİ").Activate
Sheets("a4").Select
ActiveWindow.SelectedSheets.PrintPreview
End Sub
Sub deneme_MTK()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Worksheets("a4").Activate
Range("c19").Select
ActiveCell.EntireRow.AutoFit
If ActiveCell.Value = Empty Then
ActiveCell.EntireRow.AutoFit
Else
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Worksheets("VERİ GİRİŞİ").Activate
Sheets("a4").Select
ActiveWindow.SelectedSheets.PrintPreview
End Sub
