+A1 makrosu

[teonet]

Merhaba Hocalarım

excel'de A1 den A2000 e kadar olan hücrelere +A1 diyerek H1 den H2000 e kadar yapıyorum. Bunu macro ile yapmam mümkün mü? Ve otomatik olarak yada hücre değiştikçe otomatik olarak yenileyecek.

Şimdiden çok teşekkürler

 

[muhasebeciyiz]

Sub OtomatikNumarala()

Dim baslangicNumarasi As Integer
baslangicNumarasi = 1

Dim hedefAralik As Range
Set hedefAralik = Range("A1:A" & 2000)

For Each hücre In hedefAralik
    hücre.Value = baslangicNumarasi
    baslangicNumarasi = baslangicNumarasi + 1
Next hücre

End Sub

Bu makro, sayıları sıralı olarak artırır ve A1:A2000 hücrelerini varsayar. Başlangıç numarasını veya hedef aralığını değiştirmek isterseniz, makrodaki değişkenleri buna göre güncelleyin.Başka bir numaralandırma düzeni istiyorsanız, makrodaki kodu buna göre özelleştirmeniz gerekir.

 

[teonet]

değerli cevabın için çok teşekkür ederim. A da bulunan sayı veya değeri diğer H alanına almak istiyorum. Sıralı bir veri değil. Tarih olabilir isim olabil gibi.

 

[cems]

Sub VeriKopyala()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow ws.Cells(i, "H").Value = ws.Cells(i, "A").Value
Next i
End Sub

 

[teonet]

Sayım Cems
Aşağıdaki alan kırmızı renk "hata veriyor"

For i = 1 To lastRow ws.Cells(i, "H").Value = ws.Cells(i, "A").Value

 

[cems]

sub VeriKopyala()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value
Next i
End Sub


Bu kod, "Sheet1" sayfasındaki A sütunundaki verileri H sütununa kopyalar. Eğer bu hala kırmızı renkli bir hata veriyorsa, hata mesajını paylaşın

 

[cems]

A da bulunan sayı veya değeri diğer H alanına almak istiyorum. Sıralı bir veri değil. Tarih olabilir isim olabil gibi.

Bunlar farklı degisken ve farklı dim gerektirir

Sub VeriKopyala()
Dim ws As Worksheet
Dim lastRowA As Long
Dim i As Long
Dim destRow As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' H sütununda ilk boş hücrenin satır numarasını bul
destRow = 1
Do Until IsEmpty(ws.Cells(destRow, "H"))
destRow = destRow + 1
Loop

' A sütunundaki her bir hücreyi H sütununa kopyala
For i = 1 To lastRowA
ws.Cells(destRow, "H").Value = ws.Cells(i, "A").Value
' H sütunundaki bir sonraki boş hücreye geç
destRow = destRow + 1
Next i
End Sub

 

[necati]

Merhaba, o satırda iki satırlık birleşmiş bir kod var. Satırları ayırırsanız problem kalmaz.

Sayım Cems
Aşağıdaki alan kırmızı renk "hata veriyor"

For i = 1 To lastRow ws.Cells(i, "H").Value = ws.Cells(i, "A").Value

Şu şekil:
For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value

 

[teonet]

sub VeriKopyala()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value
Next i
End Sub


Bu kod, "Sheet1" sayfasındaki A sütunundaki verileri H sütununa kopyalar. Eğer bu hala kırmızı renkli bir hata veriyorsa, hata mesajını paylaşın

Sayın Cem Değerli cevabın için teşekkür ederim.
bu güzel çalıştı. çok da güzel oldu. Fakat "Run Sub" butonuna basmadan yani makroyu çalıştırmadan anlık olarak kendi çalışabilir mi?

 

[cems]

sayfa açılırken tetiklenecek şekilde kod yazmak da cozer ve run sub kullanmaya gerek kalmaz. Ancak dosyanızı bilmiyorum eklemediğinizden deneme yapamam.Bu arada sayın @necati nin uyarısını da dikkate alınız zira birlestirilmis hucreler genelde problem kaynagı olur

deneyin :


Private Sub Workbook_Open()
Call VeriKopyala ' VeriKopyala makrosunu çağırarak otomatik çalışmasını sağlar
End Sub

Sub VeriKopyala()
Dim ws As Worksheet
Dim lastRowA As Long
Dim i As Long
Dim destRow As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' H sütununda ilk boş hücrenin satır numarasını bul
destRow = 1
Do Until IsEmpty(ws.Cells(destRow, "H"))
destRow = destRow + 1
Loop

' A sütunundaki her bir hücreyi H sütununa kopyala
For i = 1 To lastRowA
ws.Cells(destRow, "H").Value = ws.Cells(i, "A").Value
' H sütunundaki bir sonraki boş hücreye geç
destRow = destRow + 1
Next i
End Sub



Bu kod, çalışma kitabı açıldığında Workbook_Open olayını kullanarak VeriKopyala makrosunu otomatik olarak çağırır. Böylece, dosya açıldığında verilerinizi otomatik olarak kopyalamak için herhangi bir işlem yapmanıza gerek kalmaz.

 

[cems]

ya da bu kodu deneyin


Private Sub Workbook_Open()
Call VeriKopyala ' VeriKopyala makrosunu çağırarak otomatik çalışmasını sağlar
End Sub

Sub VeriKopyala()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value
Next i
End Sub

Hangisi sizin icin dogru calısırsa onu kullanın , ikisi de dosya acıldıgında calısır mudahaleye gerek olmaz

 

[teonet]

Merhaba, o satırda iki satırlık birleşmiş bir kod var. Satırları ayırırsanız problem kalmaz.


Şu şekil:
For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value

Farkında değildim, uyarınız için teşekkür ederim.

 

[teonet]

ya da bu kodu deneyin


Private Sub Workbook_Open()
Call VeriKopyala ' VeriKopyala makrosunu çağırarak otomatik çalışmasını sağlar
End Sub

Sub VeriKopyala()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1" yerine çalışma sayfanızın adını yazın
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
ws.Cells(i, "H").Value = ws.Cells(i, "A").Value
Next i
End Sub

Hangisi sizin icin dogru calısırsa onu kullanın , ikisi de dosya acıldıgında calısır mudahaleye gerek olmaz

Her iki değerli cevabınız için teşekkür ederim. Deneyeceğim. Çok sağolun.