Sub Başka_Dosyadan_Bütün_Sayfaları_Taşıyarak_Kopyala()
'ThisWorkbook.Worksheets.Select
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Dim dosya
Dim wb As Workbook
dosya = Dir(a)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
ActiveWorkbook.Worksheets.Select
Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets.Copy Before:=Workbooks(dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
End Sub
Sub ekMakro8()
'ThisWorkbook.Worksheets.Select
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
sıra = ActiveWorkbook.Sheets.Count
a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Dim dosya
Dim wb As Workbook
dosya = Dir(a)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
sıra = ActiveWorkbook.Sheets.Count
Dim myArray() As Variant
Dim i As Integer
For i = 1 To sıra 'Sheets.Count
ReDim Preserve myArray(i - 1)
myArray(i - 1) = i
Next i
Sheets(myArray).Select
Sheets(1).Activate
'Windows(dosya_adı).Activate
Sheets(myArray).Copy Before:=Workbooks(dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
End Sub
üstadlar, yukarıdaki yazılı kod çalıştırıldığında sadece XLS dosyaları görüp işlem yapıyor. XLSX dosyaları görmüyor. yardımcı olursanız sevinirim...
'ThisWorkbook.Worksheets.Select
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Dim dosya
Dim wb As Workbook
dosya = Dir(a)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
ActiveWorkbook.Worksheets.Select
Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets.Copy Before:=Workbooks(dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
End Sub
Sub ekMakro8()
'ThisWorkbook.Worksheets.Select
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
sıra = ActiveWorkbook.Sheets.Count
a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Dim dosya
Dim wb As Workbook
dosya = Dir(a)
If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
sıra = ActiveWorkbook.Sheets.Count
Dim myArray() As Variant
Dim i As Integer
For i = 1 To sıra 'Sheets.Count
ReDim Preserve myArray(i - 1)
myArray(i - 1) = i
Next i
Sheets(myArray).Select
Sheets(1).Activate
'Windows(dosya_adı).Activate
Sheets(myArray).Copy Before:=Workbooks(dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
End Sub
üstadlar, yukarıdaki yazılı kod çalıştırıldığında sadece XLS dosyaları görüp işlem yapıyor. XLSX dosyaları görmüyor. yardımcı olursanız sevinirim...
