sayfalara dağıt makrosu

[yunka]

Sub Dağıt()
On Local Error GoTo 20
Dim i As Long
Dim Sayfa As String
Dim cht As ChartObject
Set sg = Sheets("Veri")
sg.Select
d = InputBox("Veri Tarihini gg/aa/yyyy Şeklinde Giriniz.", "Uyarı", Date)
If Not IsDate(d) Then
MsgBox "Girilen değer tarih değildir." & Chr(10) & "Tekrar giriş yapınız."
Exit Sub
End If

For i = 7 To [b65536].End(3).Row

Sayfa = Trim(Cells(i, "b"))
If Sheets("veri").Range("b" & i).Offset(0, -1).Value = "x" Then

If Not SayfaVarMi(Sayfa) Then
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Sayfa
sg.Select
Range("b1:j1").Copy Sheets(Sayfa).[b2]
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":j" & i).Copy Sheets(Sayfa).Range("B2") 'Sheets(Sayfa).Range("B" & Sheets(Sayfa).[a65536].End(3).Row + 1)
Sheets(Sayfa).Range("A2").Value = d
Sheets(Sayfa).Columns(1).EntireColumn.AutoFit
For Each cht In Sheets(Sayfa).ChartObjects
cht.Chart.SetSourceData Sheets(Sayfa).Range("C1:F38"), xlColumns
Next
w = Sheets(Sayfa).Cells(65536, "B").End(3).Row - 1
If w >= 99 Then
Sheets(Sayfa).Rows("100:100").Delete Shift:=xlUp
End If

End If
Next i
MsgBox "Veri Aktarma İşlemi Tamamlandı."
20:
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
yukardaki makroyu sayfalara dağıtırken örneğin sayfa sütünlarına veri sayfasının b sütununun ilgili sayfanın c sütununa veya veri sayfasındaki d sütunun ilgili sayfanın h sütünuna yazdırılmasını sağlamak için nasıl bir değişiklik
gerekir.

 

[yunka]

güncel soru

 

[yunka]

sorumu güncelledim