formülleri değer olarak yapıştırma

Z

zıropcin

Katılım
9 Kasım 2023
Mesajlar
6
Excel Vers. ve Dili
2007 türkce
merhaba arkadaşlar sayfalara dağıt makrom var ancak formüllü veriyi sayfalara dağıtıyor fakat formül olarak yapıştırıyor bunu değer olarak yapıştırmasını istersek acaba nereyi değiştirmemiz gerekir uğraştım ancak yapamadım yardımcı olurmusunuz.


For i = 2 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:bg1").Copy Sheets(Sayfa).[b2]
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":bg" & 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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
Range("b1:bg1").Copy Sheets(Sayfa).[b2]
Range("b" & i & ":bg" & i).Copy Sheets(Sayfa).Range("B2")

Bu iki satırı


Range("b1:bg1").Value=Sheets(Sayfa).[b2].Value
Range("b" & i & ":bg" & i).Value=Sheets(Sayfa).Range("B2").Value

olarak deneyin.
 
Z

zıropcin

Katılım
9 Kasım 2023
Mesajlar
6
Excel Vers. ve Dili
2007 türkce
recepkull' Alıntı:
Range("b1:bg1").Copy Sheets(Sayfa).[b2]
Range("b" & i & ":bg" & i).Copy Sheets(Sayfa).Range("B2")

Bu iki satırı


Range("b1:bg1").Value=Sheets(Sayfa).[b2].Value
Range("b" & i & ":bg" & i).Value=Sheets(Sayfa).Range("B2").Value

olarak deneyin.
Genişletmek için tıkla ...
dostum denedim olmadı veri sayfasındaki satırı sildi ve ilgili sayfadaki satırıda sildi makronun tümü aşağıdadır

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



For i = 2 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:bg1").Copy Sheets(Sayfa).[b2]
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":bg" & 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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If

End If
Next i
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
Kod: 
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



For i = 2 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:bg1").Copy
Sheets(Sayfa).[b2].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False  
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":bg" & i).Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If

End If
Next i
Bu şekilde deneyin. Ayrıca kopyalanan hücrelerin bulunduğu sayfa adını belirtirseniz kodunuz daha sağlıklı alışacaktır.

Sheets("sayfaadı").Range("b1:bg1").Copy
Sheets("sayfaadı").Range("b" & i & ":bg" & i).Copy
 
Z

zıropcin

Katılım
9 Kasım 2023
Mesajlar
6
Excel Vers. ve Dili
2007 türkce
recepkull' Alıntı:
Kod: 
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



For i = 2 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:bg1").Copy
Sheets(Sayfa).[b2].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False 
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":bg" & i).Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If

End If
Next i
Bu şekilde deneyin. Ayrıca kopyalanan hücrelerin bulunduğu sayfa adını belirtirseniz kodunuz daha sağlıklı alışacaktır.

Sheets("sayfaadı").Range("b1:bg1").Copy
Sheets("sayfaadı").Range("b" & i & ":bg" & i).Copy
Genişletmek için tıkla ...
tüm kod bu şekildedir dostum eline sağlık işimi gördün teşekkür ederim veri sayfasındaki verileri önce isimlerine göre sayfa açıyor
daha sonra zamanlama makrosuyla istenilen süre içerisinde dakikada bir veya saatte bir ilgili sayfalar aktarıyor.


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



For i = 2 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:f1").Copy
Sheets(Sayfa).[b2].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":f" & i).Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If

End If
Next i
20:

Call zamanla
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

buda zamanlama makrosudur saat 10 ile 18 arasında dakikada bir dağıt makrosunu çalıştırıyor
Sub zamanla()
If ((Time > TimeValue("10:00:00")) And (Time < TimeValue("18:00:00"))) Then
Application.OnTime Now + TimeValue("00:01:00"), "DAĞIT "
End If
End Sub
 
Z

zıropcin

Katılım
9 Kasım 2023
Mesajlar
6
Excel Vers. ve Dili
2007 türkce
zıropcin' Alıntı:
tüm kod bu şekildedir dostum eline sağlık işimi gördün teşekkür ederim veri sayfasındaki verileri önce isimlerine göre sayfa açıyor
daha sonra zamanlama makrosuyla istenilen süre içerisinde dakikada bir veya saatte bir ilgili sayfalar aktarıyor.


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



For i = 2 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:f1").Copy
Sheets(Sayfa).[b2].PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

Sheets(Sayfa).Rows("2:2").Insert Shift:=xlDown
Range("b" & i & ":f" & i).Copy
Sheets(Sayfa).Range("B2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'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 >= 500 Then
Sheets(Sayfa).Rows("501:502").Delete Shift:=xlUp
End If

End If
Next i
20:

Call zamanla
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

buda zamanlama makrosudur saat 10 ile 18 arasında dakikada bir dağıt makrosunu çalıştırıyor
Sub zamanla()
If ((Time > TimeValue("10:00:00")) And (Time < TimeValue("18:00:00"))) Then
Application.OnTime Now + TimeValue("00:01:00"), "DAĞIT "
End If
End Sub
Genişletmek için tıkla ...
ALTTAKİLER VERİ SAYFASIDIR
hisselerin önüne X KOYMAZSANIZ ONU DAĞITMAZ YANİ X SEÇİM İÇİNDİR
 

HİSSE

ACILIS

YUKSEK

DUSUK

SON

X

YEOTK.E

233​

241,3​

230​

235,8​

X

CWENE.E

317​

322​

311​

316,5​

 

SAYAS.E

104,8​

105,3​

101,1​

103​

 

SDTTR

312,25​

317,75​

306​

316,25​

 

KONTR

282,5​

294,25​

281​

290,5​

 

USDTRY

28,4593​

28,5387​

28,4523​

28,466​

 
Cevap yazmak için giriş yap yada kayıt ol.
Üst