- Katılım
- 7 Eylül 2004
- Mesajlar
- 946
- Excel Vers. ve Dili
- Excel-2003
- Altın Üyelik Bitiş Tarihi
- 16.08.2026
A Klasörüm Var. A Klaösrü altında B klaösrü ve onun altında bazen klasör bazen de excel dosyaları var.
Tüm klasör altlarındaki Excel dosyalarından sabit sayfa adı olan "Ödeme List" adlı sayfalardaki verileri tek bir excel dosyasında birlerştirmek istiyorum.
Yalnız açılıp içinden veri alınacak dosya altındaki excel dosyalarının "Ödeme List" sayfalarının bazılarında sütunlar gizlenmiş halde.. Ve başka sayfalardan formille veri alıyor. Metin olarak gelmesi gerekiyor
İstediğim bu excel dosyalarının "Ödeme List" sayfasındaki verileri tek bir yere almak.
Tüm excel dosyalarının veri başlangıç satırı B3..
Yan yana sütunların sonu N3
Sayfa satır sayısı bazen 120 bazen de 300. Sınırız aşağıya doğru veri alabilmeli.
Şu kodu denedim ama istediğimi vermedi. Gizli sütunları açıp getirmedi.
Şimdiden teşekkür ederim.
Tüm klasör altlarındaki Excel dosyalarından sabit sayfa adı olan "Ödeme List" adlı sayfalardaki verileri tek bir excel dosyasında birlerştirmek istiyorum.
Yalnız açılıp içinden veri alınacak dosya altındaki excel dosyalarının "Ödeme List" sayfalarının bazılarında sütunlar gizlenmiş halde.. Ve başka sayfalardan formille veri alıyor. Metin olarak gelmesi gerekiyor
İstediğim bu excel dosyalarının "Ödeme List" sayfasındaki verileri tek bir yere almak.
Tüm excel dosyalarının veri başlangıç satırı B3..
Yan yana sütunların sonu N3
Sayfa satır sayısı bazen 120 bazen de 300. Sınırız aşağıya doğru veri alabilmeli.
Şu kodu denedim ama istediğimi vermedi. Gizli sütunları açıp getirmedi.
Şimdiden teşekkür ederim.
Kod:
Sub BİRLESTİR()
If MsgBox(" E M İ N M İ S İ N İ Z ?", vbYesNo, "Dikkat!") = vbNo Then Exit Sub
Dim NumFound As Long, sno As Long, satir As Long, yurtSutunu As Long, ilkSatir As Long
Dim dosyaYeri As String, sifre As String
Dim SK As Worksheet, SA As Worksheet
Dim SK1 As Workbook
Set SA = Workbooks("AYIR BİRLEŞTİR").Sheets("Liste")
dosyaYeri = Cells(1, 2).Value
sifre = Cells(1, 6).Value
sat = 4
SA.Range("B3:K" & Rows.Count).Clear
sDir = Dir$(dosyaYeri & "\*.xls*", vbNormal)
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Do Until LenB(sDir) = 0
dosya = dosyaYeri & "\" & sDir
Workbooks.Open dosya, Password:=sifre
'S1 = ActiveSheet.Name
1
Set SK1 = Workbooks(sDir)
Set SK = Workbooks(sDir).Sheets(S1)
son = SK.Cells(Rows.Count, "B").End(3).Row
SK.Range("B3:K" & son).Copy SA.Cells(sat, "B")
sat = (sat - 4) + son + 1
sDir = Dir$
SK1.Close: Set SK1 = Nothing
Set SK = Nothing
Loop
Application.ScreenUpdating = True: Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Son düzenleme: