arkadaşlar formül kopyalıyor diğer sayfaya yapıştırıyor fakat yeni değeri altına yapıştırmıyor eski değerleri siliyor alt alta yapıştırmak için formüllere ne eklemeliyim her iki formülde aynı hatayı veriyor yardımcı olursanız sevinirim teşekkürler
1. makro
Sub aktar()
'
' Makro3 Makro
'
'
Range("A1:M30").Select
Selection.Copy
Sheets("ARŞİV").Select
a = Sheets("ARŞİV").Cells(Rows.Count, 2).End(xlUp).Row
If a = 1 Then
Cells(1, 1).Select
[f3] = [f3].Value
Else
Cells(a + 3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ActiveSheet.Paste
End If
Application.CutCopyMode = False
Cells(a + 5, "f") = Cells(a + 5, "f").Value
Sheets("Genel").Select
[a1].Select
End Sub
2.makro
Sub sayfalara_ayrı_ayrı_aktar()
Dim i As Integer, j As Integer
Dim Sayfa As String
Dim S1 As Worksheet
Set S1 = Sheets("Genel")
Application.ScreenUpdating = False
For j = 3 To Worksheets.Count
Sheets(j).Cells.Delete Shift:=xlUp
Next j
For i = 3 To S1.[B65536].End(3).Row
Sayfa = S1.Cells(i, "C")
If Not SayfaVarMi(Sayfa) Then
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Sayfa
S1.Select
End If
S1.Range("B2:M2").Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
S1.Range("B" & i & ":M" & i).Copy
Sheets(Sayfa).Range("B" & Sheets(Sayfa).[B65536].End(3).Row + 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False
Sheets(Sayfa).Range("B:M").EntireColumn.AutoFit
Next i
Set S1 = Nothing: Sayfa = vbNullString
j = Empty: i = Empty
Application.ScreenUpdating = True
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
1. makro
Sub aktar()
'
' Makro3 Makro
'
'
Range("A1:M30").Select
Selection.Copy
Sheets("ARŞİV").Select
a = Sheets("ARŞİV").Cells(Rows.Count, 2).End(xlUp).Row
If a = 1 Then
Cells(1, 1).Select
[f3] = [f3].Value
Else
Cells(a + 3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ActiveSheet.Paste
End If
Application.CutCopyMode = False
Cells(a + 5, "f") = Cells(a + 5, "f").Value
Sheets("Genel").Select
[a1].Select
End Sub
2.makro
Sub sayfalara_ayrı_ayrı_aktar()
Dim i As Integer, j As Integer
Dim Sayfa As String
Dim S1 As Worksheet
Set S1 = Sheets("Genel")
Application.ScreenUpdating = False
For j = 3 To Worksheets.Count
Sheets(j).Cells.Delete Shift:=xlUp
Next j
For i = 3 To S1.[B65536].End(3).Row
Sayfa = S1.Cells(i, "C")
If Not SayfaVarMi(Sayfa) Then
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Sayfa
S1.Select
End If
S1.Range("B2:M2").Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
S1.Range("B" & i & ":M" & i).Copy
Sheets(Sayfa).Range("B" & Sheets(Sayfa).[B65536].End(3).Row + 1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False
Sheets(Sayfa).Range("B:M").EntireColumn.AutoFit
Next i
Set S1 = Nothing: Sayfa = vbNullString
j = Empty: i = Empty
Application.ScreenUpdating = True
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
