Forum
Bildirimler
Hepsini Temizle
Microsoft Office
5
Yazılar
2
Üyeler
2
Reactions
815
Görüntüleme
Konu başlatıcı
merhabalar,
elimde 600 kayıt var ve sütun sütun değilde satır satır veriler eposta mesajından copy paste ile excele aktarılacak.
copya edeceğim veri örneği aşağıda ki gibi
adı: Kazım
Kimlik: 000111
Doğum tarihi: 01-01-1977
Sebep: Test Test
2nci postada
adı: Ali Veli
Kimlik: 003456
Doğum tarihi: 01-03-1979
Sebep: Test Test falan filan
....
600ncü postada ise
adı: sdhhdh
Kimlik: 0790111
Doğum tarihi: 01-01-1954
Sebep: Test Test
gibi bunların her birisini copy paste edipn her seferinde worksheet 1 in 1nci satırın 1nci sütununa yapıştıracağım ve neticede her paste edilen işlemden sonra worksheet 2 de ise bu alanların otomatik olarak kolon kolon aşağıda ki verilen örnekte olmasını nasıl sağlatabilirim.
Adı: | Kimlik: | Doğum Tarihi | Sebep
Kazım | 000111 | 01-01-1977 | Test Test
Ali Veli | 003456 | 01-03-1979 | Test Test falan filan
.
.
.
sdhhdh | 0790111 |01-01-1954 | Test Test
Umarım bu konuda yardım alabilirim. Şimdiden teşekkürler.
Gönderildi : 08/04/2020 23:54
Merhabalar,
Satırlar arasında boşluk var mı ? 1 eposta , 2 eposta vs. isterseniz uygulanmış örnek dosya ekleyin, oradan gidelim
Gönderildi : 09/04/2020 09:34
Merhaba,
Örnek dosyayı inceleyin.
Sub DUZENLE()
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("LISTE")
Set S2 = Sheets("ISTENILEN")
S1.Range("B2:C" & Rows.Count).ClearContents
S2.Range("A2:E" & Rows.Count).ClearContents
SON = S1.Range("a65536").End(3).Row
SAT = 2
SAY = 1
For i = 2 To SON
S1.Range("b" & i) = LTrim(Mid(S1.Range("A" & i), InStr(S1.Range("A" & i), ":") + 1, 1000))
S1.Range("C" & i) = SAY
If SAY = 4 Then
D = 1
s = S1.Range("c65536").End(3).Row
For Z = S1.Range("c1").End(4).Row To s
If D = 1 Then
S2.Range("A" & SAT) = (S1.Range("B" & Z))
ElseIf D = 2 Then
S2.Range("B" & SAT) = (S1.Range("B" & Z))
ElseIf D = 3 Then
S2.Range("C" & SAT) = (S1.Range("B" & Z))
ElseIf D = 4 Then
S2.Range("D" & SAT) = (S1.Range("B" & Z))
End If
D = D + 1
S1.Range("c" & Z) = ""
Next Z
SAT = SAT + 1
D = 1
SAY = 0
End If
SAY = SAY + 1
Next i
MsgBox "işlem tamam"
End Sub
Bu ileti 5 yıl önce Vedat OZER tarafından düzenlendi
Gönderildi : 09/04/2020 11:33
Konu başlatıcı
@vedatozer_2 Çok teşekküğr ederim. Kesinlikle sorumun cevabı buydu. Emeğinize sağlık.
Gönderildi : 09/04/2020 12:56
Vedat OZER and Vedat OZER reacted
