Soru Bir Klasördeki Excel Dosyasındaki Verileri Alma

Torchh

Altın Üye
Katılım
9 Aralık 2023
Mesajlar
24
Excel Vers. ve Dili
Office365
Altın Üyelik Bitiş Tarihi
09-12-2024
Excelde vba ile bir klasördeki excel dosyalarını ve sayfalarını bir sayfaya kopyalama konusunda yardımcı olur musunuz?
 

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
566
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Bakınız. Tek sayfayımı Tek hücreyimi çekeceksiniz.Tam netlik yok.

 

Torchh

Altın Üye
Katılım
9 Aralık 2023
Mesajlar
24
Excel Vers. ve Dili
Office365
Altın Üyelik Bitiş Tarihi
09-12-2024
klasörde bulunan 1.exceldeki tüm sayfaları 2. exceldeki tüm sayfaları veri isimli excele aktarmasını istiyorum gönderdiklerinizi inceleyeceğim hocam.
 
Katılım
29 Ocak 2014
Mesajlar
130
Excel Vers. ve Dili
OpenOffice,
Office 365,
Google Sheets,
Excel Vba
Altın Üyelik Bitiş Tarihi
24.12.2022
Dosyaları seç yaparak mı? çekmek istiyorsun. Yoksa sabit isimli dosyadan mı çekmek istiyorsun.
 
Katılım
29 Ocak 2014
Mesajlar
130
Excel Vers. ve Dili
OpenOffice,
Office 365,
Google Sheets,
Excel Vba
Altın Üyelik Bitiş Tarihi
24.12.2022
Private Sub CommandButton1_Click()
Dim verial As String
Dim kitap As Workbook
Dim fd As FileDialog

Application.ScreenUpdating = False

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
.Title = "Dosya seç "
.Filters.Clear
.Filters.Add "Excel Dosyaları", "*.xls*"
.InitialFileName = Environ("USERPROFILE") & "\Desktop\" 'masaüstü seçme
If .Show = True Then
verial = .SelectedItems(1)
End If
End With

If verial <> "" Then
Set kitap = Workbooks.Open(verial)
Range("F2:AK99999").ClearContents ' H2:AO99999 hücre aralığını silme
kitap.ActiveSheet.Range("A2:AF9999").Copy
Range("F2").PasteSpecial xlPasteValues
Application.CutCopyMode = False ' Kaydetme uyarısını göstermemek için
Application.DisplayAlerts = False ' Dosyayı kaydet
kitap.Save ' Dosyayı kapat
kitap.Close ' Kaydetme uyarısını tekrar aktif hale getir
Application.DisplayAlerts = True
MsgBox "Seçilen Sipariş Raporu Aktarılmıştır.", vbInformation, "Bilgi" ' İşlem sonunda mesaj kutusu göster
End If
Application.ScreenUpdating = True

End Sub
 
Üst