Yardımcı kitap ve sayfa adları macro ile değişken olabilir mi?

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Veri aldığım kitaplar İzin, Rapor ve Ücretsiz'dir. Aynı şekilde de içindeki sayfa isimleri de aynı;
Sistemden veri aldığım zaman kitap isimlerine ve sayfa isimlerine numara ekleniyor Örneğin İzin kitabı önce İzin77 ise İzin78 olarak içerisindeki sayfa adı da önce İzin77, sonra İzin78 olarak geliyor.
Kitap ve Sayfa isimlerini değiştirirsem Kitap: İzin Sayfa: İzin yaparsam aşağıdaki macro çalışıyor.
Macro üzerinde bir değişiklik yapılıp da örneğin; Kitap için : İzin*.*, Sayfa için : İzin*.* gibi değişken özelliği eklenebilir mi? Bu kısma düzenleyemedim. Yardımcı olabilecek arkadaşlara teşekkürler.

Sub GetData()

Dim sFile As Workbook, tFile As Workbook
Dim dosya As String, kes, parcaAl
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet

Set tFile = ThisWorkbook
Set s1 = tFile.Sheets("İzin")
Set s2 = tFile.Sheets("Rapor")
Set s3 = tFile.Sheets("Ücretsiz")

Application.ScreenUpdating = False
dosya = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.*")
With s1
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With

With s2
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With

With s3
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
End With

Do While dosya <> ""
If dosya <> ThisWorkbook.Name Then
Set sFile = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & dosya)
kes = Split(dosya, ".")
parcaAl = Mid(dosya, 1, Len(dosya) - Len(kes(UBound(kes))) - 1)
If parcaAl = "İzin" Then
sFile.Worksheets("İzin").Range("A1").CurrentRegion.Offset(1).Copy _
s1.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
ElseIf parcaAl = "Rapor" Then
sFile.Worksheets("Rapor").Range("A1").CurrentRegion.Offset(1).Copy _
s2.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
ElseIf parcaAl = "Ücretsiz" Then
sFile.Worksheets("Ücretsiz").Range("A1").CurrentRegion.Offset(1).Copy _
s3.Cells(Rows.Count, 1).End(3).Offset(1, 0)
Application.CutCopyMode = False
End If
Application.CutCopyMode = False
sFile.Close
End If
dosya = Dir
Loop
Application.ScreenUpdating = True
s1.Activate
s1.Cells(1, 1).Activate
Sheets("TümVeri").Select
Range("AT2").Select
MsgBox "Veri aktarma işlemi bitti."
Set sFile = Nothing: Set tFile = Nothing: parcaAl = vbNullString
Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Dosyaların içinde tek sayfa mı oluyor? Ya da bahsettiğiniz sayfalar dosyanın içinde ilk sırada mı oluyor?
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Yalnız hocam verileri aldığım (çağırdığım) yardımcı üç adet İzin, Rapor ve Ücretsiz kitaptan oluşmaktadır. İçerisinde bulunan Sayfa isimleri ise yine aynı İzin, Rapor ve Ücretsiz dir. Sistemden tekrar bu dosyaları aldığımda numaralı gelmektedir. İzin1, Rapor1 ve Ücretsiz1 hem kitap ismi hem de sayfa isimleri değişken oluyor. İzin, Rapor ve Ücretsiz sadece kitap ve sayfa isimleri sabit sonu değişken bu bölümü çözebilir miyiz?
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Sayın Haluk bey önceki konuda kitap ve sayfa adlarının değişmesi yoktu; sistemden veri aldığımızda gelen/alınan listelere numara ekleniyor.
İşlemleri kolaylaştırıp tek tip manuelden uzak çalışma yapmak isiyorum.
Ya sayfaları açıp bir bir sayfa adı ve kitap adı değiştirmek yada verileri manuel kopyalayıp ana dosyadaki sayfalarına yapıştırmak gerekiyor.
Yardımlarınıza sona geldik. Kitap ve sayfa adının başlangıcı sabit sonundaki numara kısımları değişken, isimler sabit olsabir sorun yok.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Tamam..... öbür konuya bununla ilgili bir revize dosya ekleyeceğim birazdan, oradan takip edersiniz.

.
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Tamam teşekkür ederim.
 
Üst