şarta göre range

[honestman]

[bamm] Merhaba,

A EKS. 12112598 12109791
A EKS. 12116578 12110851 12112890 12114904 12114725
AB EKS. 12072736
AB EKS. 12112719 12085863
ABB EKS. 12114982 12118702 12116879 12116759
ABB EKS. 12104545 12104526 12103675 12101188 12099918 12099919 12109003

Bu sütunları aşağıdaki hale makro ile nasıl getirebilirim?

A EKS.
12112598
12109791
A. EKS.
12116578
12110851
12112890
12114904
12114725
AB EKS.
12072736
AB EKS.
12112719
12085863

Bu şekilde devam edecek. Yardımcı olur musunuz?

 

[mrcylmz_61]

dosyanızı gönderirseniz yardımcı olmaya çalışalım.

 

[Ömer]

Merhaba,

Örneğin;

A EKS. 12112598 12109791

Bu değerde her veri ayrı sütuda mı yoksa tek bir satırın içinde mi?

 

[honestman]

Ayrı sütunda Ömer bey. Eklemeyi unuttuğum bir şey var bu istediğim sonucu 2. sayfada vermeli. Yardımınıza teşekkürler. Örnek dosya ektedir.

 

[Ömer]

A-B-D-E sütunları aktarıma dahil olmayacak mı?

 

[honestman]

B sutunu aynen aktarılacak ama işin zor kısmı olmadığı için yazmamıştım. İlgilendiğiniz için teşekkürler.

 

[bedri41]

Dosyanızdaki bu alt alta getirmek istediğiniz verileri mouse ile seçin (D ve E sütunları girmeyecekse silin) seçtiğiniz bölümü kopyalayıp diğer sayfada özel yapıştır da İşlemi tersine çevir kutucuğu işaretli olarak tamam deyin.

Kolay Gelsin

Not: şimdi farkettim. hepsi tek sütun olacaksa mesajımı dikkate almayın

 

[Ömer]

Yapmak istediğinizi cümlelerden anlayamadım. Sheet2 sayfasında olması gereken 1-2 satırı manuel hazırlayıp dosyayı tekrar eklermisiniz.

 

[honestman]

Bedri bey,

Transpose ile denedim ama istediğim gibi olmuyor malesef...

 

[honestman]

Sayfa 2 ye istediğim halini ekledim.

 

[Ömer]

Bu şekilde deneyin.

Sub duzenle()
 
    Dim S1 As Worksheet, i As Long, son As Long
 
    Set S1 = Sheets("Sheet1")
 
    Application.ScreenUpdating = False
    Sheets("Sheet2").Select: Range("A2:C" & Rows.Count).Clear
 
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        son = Cells(Rows.Count, "C").End(xlUp).Row + 2
        Cells(son, "A") = S1.Cells(i, "B")
        Cells(son, "B") = S1.Cells(i, "C")
 
        S1.Range(S1.Cells(i, "D"), S1.Cells(i, "D").End(xlToRight)).Copy
        Cells(son, "C").PasteSpecial Paste:=xlPasteAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next i
 
    Application.CutCopyMode = False
    Rows(2).Delete
    Cells.EntireColumn.AutoFit
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[honestman]

Tarih formatını da düzeltirsek ellerinize sağlık diyeceğim

 

[Ömer]

Cells.EntireColumn.AutoFit

Satırından sonra aşağıdaki satırı ekeleyin.

Range("A:A").NumberFormat = "m/d/yyyy"

.

 

[honestman]

Yardımınız için çok teşekkür ederim. Allah razı olsun...

 

[Ömer]

Rica ederim. Allah hepimizden razı olsun.