yusuf1284
Altın Üye
- Katılım
- 17 Ocak 2015
- Mesajlar
- 224
- Excel Vers. ve Dili
- Office Pro 2016 TR
- Altın Üyelik Bitiş Tarihi
- 09-02-2028
Değerli hocalarım herkesin bayramını kutlarım
Aşağıda yazmış olduğum kodlarda çekilen verilerin Excel dosyasını(sonuc sayfası dışında kalan tüm sayfalar) seçerek nasıl yaptırabilirim dosyalar askeri olduğundan ekleyemedim yine bir örnek düzenlerim istenirse
Aşağıda yazmış olduğum kodlarda çekilen verilerin Excel dosyasını(sonuc sayfası dışında kalan tüm sayfalar) seçerek nasıl yaptırabilirim dosyalar askeri olduğundan ekleyemedim yine bir örnek düzenlerim istenirse
Rich (BB code):
'SAYFADAN VERİ ÇEK
Sub test()
Dim sayfanu As Integer
Set S1 = Sheets("sonuc")
S1.Select
S1.Range("F2:I9999").Clear
ActiveSheet.ListObjects("Tablo1").Resize Range("$F$1:$I$2")
Application.ScreenUpdating = False
For x = 1 To Sheets.Count
KişiSayısı = Range("F4:F14").Cells.Count 'hücre sayma
If Range("f2").Value = "" Then
Son = 2
Else
Son = S1.Cells(S1.Rows.Count, "F").End(3).Row + 1
End If
SonY = Son + KişiSayısı - 1
S1.Range("F" & Son & ":" & "h" & SonY).Value = Sheets(x).Range("F4:H14").Value
S1.Range("I" & Son & ":" & "I" & SonY).Value = DateValue(Format(Split(Sheets(x).Name, " ")(0), "dd.mm.yyyy"))
If x = Sheets.Count - 1 Then: S1.Range("F1").Select: Application.ScreenUpdating = True: Exit Sub
Next
Application.ScreenUpdating = True
End Sub
'SAYFADAN VERİ ÇEK
Sub test()
Dim sayfanu As Integer
Set S1 = Sheets("sonuc")
S1.Select
S1.Range("F2:I9999").Clear
ActiveSheet.ListObjects("Tablo1").Resize Range("$F$1:$I$2")
Application.ScreenUpdating = False
For x = 1 To Sheets.Count
KişiSayısı = Range("F4:F14").Cells.Count 'hücre sayma
If Range("f2").Value = "" Then
Son = 2
Else
Son = S1.Cells(S1.Rows.Count, "F").End(3).Row + 1
End If
SonY = Son + KişiSayısı - 1
S1.Range("F" & Son & ":" & "h" & SonY).Value = Sheets(x).Range("F4:H14").Value
S1.Range("I" & Son & ":" & "I" & SonY).Value = DateValue(Format(Split(Sheets(x).Name, " ")(0), "dd.mm.yyyy"))
If x = Sheets.Count - 1 Then: S1.Range("F1").Select: Application.ScreenUpdating = True: Exit Sub
Next
Application.ScreenUpdating = True
End Sub