Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Excel'e Yeni Başlayanlar
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Excel'e Yeni Başlayanlar Excel kullanmaya yeni başladıysanız sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 14-05-2017, 16:49   #1
Robinson_Crusoe
 
Robinson_Crusoe kullanıcısının avatarı
 
Giriş: 30/08/2006
Şehir: Gaziantep,
Mesaj: 62
Excel Vers. ve Dili:
Microsoft Excel 2016 64 Bit
Varsayılan 2 Excel Dosyası Tek DosyaOlabilirmi

Diyelimki arkadaşlar a.xls uzantılı bir dosyamız var a.xls dosyasının 1 nci sayfasını alıp b.xls dosyasının 2 nci sayfasına kopyalanmasını istiyoruz bunu yapmamızın bir yolu varmı çünkü a dosyasındaki a sayfadaki bilgileri birden fazla b dosyası gibi dosyalara kopyalamam lazım,
__________________
[CENTER][B][COLOR="Red"]Çok samimi olarak kendim dediğim şeye dahil olduğum zaman ben sıcak ya da soğuga, ışık ya da gölgeye, aşk, ya da nefrete, acı, ya da lezzete dair; özel bir algıya ya da başka bir şeye daima rastlarım, ben bir algı olmaksızın herhangi bir zamanda kendimimi asla yakalayamam ve asla algıdan başka bir şey gözlüyemem.[/COLOR][/B][/CENTER]
Robinson_Crusoe Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-05-2017, 17:50   #2
numan şamil
Destek Ekibi
 
Giriş: 27/01/2011
Şehir: çorum
Mesaj: 1,071
Excel Vers. ve Dili:
Ofis 2010 Türkçe
Varsayılan

Merhaba
Değeri Halit03 hocanın kodları işini görür sanırım
b.xls dosyasında bir modül açıp kodları kopyalayıp yapıştırın ve bir düğmeye atayın
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub sayfakopyalama()
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 "Kaynak klasörü seçmediniz"
Exit Sub
End If

Kaynak = Mid(a, 1, Len(a) - Len(Dir(a)) - 1)
deg = "'" & Kaynak & "\" & "[" & Dir(a) & "]" & "x" & "'!R"

Cells(1, 1).Value = "=" & deg & 1 & "C" & 1
Cells(1, 1).Replace What:="=", Replacement:=""

alan1 = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
For k = 1 To Len(alan1)
If Mid(alan1, k, 1) = "]" Then
yer = (Len(alan1) - 6 - k)
sayfaadı = Mid(alan1, k + 1, yer)
End If
Next

Cells(1, 1).Value = sayfaadı

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
Windows(yeni_dosya_adı).Activate
Sheets(sayfaadı).Select
On Error Resume Next
Application.DisplayAlerts = False
Sheets(sayfaadı).Copy Before:=Workbooks(dosya_adı).Sheets(1)

Windows(yeni_dosya_adı).Activate
Application.DisplayAlerts = False
'ActiveWorkbook.Save
ActiveWindow.Close

Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
Cells(1, 1).Value = ""
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"

   
End Sub
numan şamil Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 13:13


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden