- 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...
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.
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.
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