Ekşi Duyuru

aşağıdaki kod ile, sheet'in A sütunundaki isimlere göre farklı excel dosyaları oluşturuluyor. mesela

A * B
1 * a
1 * c
1 * x
1 * e
1 * f
2 * w
2 * x
3 * e
3 * h
3 * j
3 * k

bu örnekte makro 1.xlsx, 2.xlsx ve 3.xlsx isminde 3 dosya oluşturuyor ve örneğin 1.xlsx'te sadece, A sütununda 1 olan kayıtlara ait veriler gösteriliyor. Fakat şöyle ki, üst başlık alanı yalnızca 1. satır olacak şekilde dosya parçalanıyor. ama ben, örneğin başlık alanı ilk 3 satır olsun, ve daha sonra 4. satırdan itibaren 1, 2, 3.. gibi A sütunundaki değerlere göre dosya parçalara ayrılsın istiyorum.

Sub sda()

satir = 1
sutun = 1

While Cells(satir, 1) <> ""
satir = satir + 1
Wend
satir = satir - 1


While Cells(1, sutun) <> ""
sutun = sutun + 1
Wend
sutun = sutun - 1

Cells.Select
'Selection.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes

For i = 1 To satir

If Cells(i, 1) <> Cells(i + 1, 1) And Cells(i + 1, 1) <> "" Then
a = i + 1

sayfaadi = Cells(a, 1)

Sheets("veriler").Select
Sheets("veriler").Copy After:=Sheets(Sheets.Count)

For j = 2 To satir

If Cells(j, 1) <> sayfaadi And Cells(j, 1) <> "" Then
Rows(j).Clear
End If

Next j

If a <> 2 Then
Rows("2:" & a - 1).Delete
End If


ActiveSheet.Name = Cells(2, 1)

a = ActiveWorkbook.Path

Sheets(sayfaadi).Select
Sheets(sayfaadi).Copy
Range("A1").Select

ActiveWorkbook.SaveAs a & "/" & sayfaadi & " deneme" & ".xlsx"
ActiveWorkbook.Close

End If

Sheets("veriler").Select


Next i


End Sub