Yardımcı Kitap Ve Sayfa Adları Macro İle Değişken Olabilir Mi? - Baskı Önizleme +- AccessTr.neT (https://accesstr.net) +-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html) +--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html) +--- Konu Başlığı: Yardımcı Kitap Ve Sayfa Adları Macro İle Değişken Olabilir Mi? (/konu-yardimci-kitap-ve-sayfa-adlari-macro-ile-degisken-olabilir-mi.html) |
Yardımcı Kitap Ve Sayfa Adları Macro İle Değişken Olabilir Mi? - yyhy - 08/05/2021 Sayın @feraz beyin ve @atoykan beyin yardımları ile son aşamasına geldiğim dosyamdaki macro ile ilgili olarak; 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ısmı düzenleyemedim. Yardımcı olabilecek arkadaşlara teşekkürler. Aşağıdaki macro üzerinde değişiklik yapılabir mi? 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 Re: Yardımcı Kitap Ve Sayfa Adları Macro İle Değişken Olabilir Mi? - feraz - 08/05/2021 Alttaki gibi değiştirin diğerlerinide ayrıca sanırım kodu değiştirmiştik. Alttaki linkteki kodlar daha uygun sanki açtığınız konuda. https://accesstr.net/konu-klasor-icerisindeki-3-yardimci-kitaptan-ana-kitaba-veri-aktarimi.html?pid=180062#pid180062
|