DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Makro1()
For i = 1 To Range("a" & Rows.Count).End(3).Row
If ActiveSheet.Range("a" & i).MergeArea.Count > 1 Then
say = ActiveSheet.Range("a" & i).MergeArea.Count
satır = ActiveSheet.Range("a" & i).MergeArea.Row
Range("B" & satır & ":B" & say + satır - 1).Copy
Range("C" & satır).PasteSpecial Transpose:=True
End If
Next
End Sub