- Katılım
- 26 Mayıs 2010
- Mesajlar
- 23
- Excel Vers. ve Dili
- 2007, türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhabaarkadaşlar benim çok önemli bi sorunum var tezim için anket düzenledim şimdi bu anketleri excel'de girmem gerekiyo ama bir türlü düzenleyemiyorum anketler ekte bana yardımcı olabilirseniz çok sevinirim...
ekteki gibi yapmak istiyorum bakarsanız sevinirim. bunun kendi anketime uyarlanmış halini yani.Merhaba
Bu başlığı bir kaç kez gördüm ama net bir açıklama yapmıyorsunuz
Gönderdiğiniz pdf'leri excelle mi aktarmak istiyorsunuz?
Yoksa pdflere benzer excel şablonu mu?
Ben pdfleri çevirip yolluyorum.
çok çok teşekkür ederim ama bi problemim daha var diğer anketi uyarladığımda olmuyo iki anket vardı ya kusura bakmayın sizinde vaktinizi alıyorum çok çok teşekkür ederim zaten büyük kısmını yaptınız.ekteki dosyayı deneyiniz.
anket sayfasının B2 hücresi boş ise veri aktarmaya izin verilmemektedir. başka kontroller de eklenebilir.
kodlar bu sayfa tasarımına göre hazırlanmış olup, sayfa yapısında değişiklik yapıldığı takdirde kodlar da buna göre güncellenmelidir.
çok çok çok teşekkür ederim, gerçekten çok büyük bi iyilik yaptınız çok sağolun...ben ikisini de aynı zannetmiştim.
anket2 olarak ekledim. hemen hemen aynı zaten.
Sub anket_aktar()
Dim ss As Long, no As Long
Dim ws1 As Worksheet, ws21 As Worksheet
Set ws1 = Sheets("VERİ")
Set ws2 = Sheets("toplu_veri")
ss = ws2.Range("A60").End(3).Row + 1
no = WorksheetFunction.Max(ws2.Range("A:A")) + 1
If ws1.Range("B8") = "" Then
MsgBox "Veri Giriniz", vbCritical, "UYARI"
Exit Sub
End If
ws2.Range("A" & ss) = no
ws2.Range("B" & ss & ":" & "J" & ss) = Application.Transpose(ws1.Range("B8:B16"))
ws2.Range("A" & ss & ":" & "J" & ss).Borders.LineStyle = xlContinuous
ws1.Range("D2") = no
End Sub
Sub anket_aktar()
Dim ss As Long, no As Long
Dim ws1 As Worksheet, ws21 As Worksheet
Set ws1 = Sheets("VERİ")
Set ws2 = Sheets("toplu_veri")
If ws2.Range("A10") = "" Then ws2.Range("A10") = 1
If ws2.Range("A10") = 1 Then
ss = 10
Else
ss = ws2.Range("A60").End(3).Row + 1
End If
If ws2.Range("A10") = 1 Then
no = 1
Else
no = WorksheetFunction.Max(ws2.Range("A:A")) + 1
End If
If ws1.Range("B8") = "" Then
MsgBox "Veri Giriniz", vbCritical, "UYARI"
Exit Sub
End If
ws2.Range("A" & ss) = no
ws2.Range("B" & ss & ":" & "J" & ss) = Application.Transpose(ws1.Range("B8:B16"))
ws2.Range("A" & ss & ":" & "J" & ss).Borders.LineStyle = xlContinuous
ws1.Range("D2") = no
End Sub