aktif kitaptan yeni açılan kitaba yapıştırma

[ufukufuk01]

Merhabalar

aktif çalışma kitabındaki L2 hücresinden başlayarak dolu olan L hücresindeki son kadar olan formülleri file diolog ile şeçtiğim çalışma kitabındaki satır1 sayfasındaki L4 hücresinden itibaren değer olarak yapıştırmasını istiyorum aşağıda onunla ilgili bir kodum var. Fakat burada kopyaladığım (L2 den itibaren olan formülleri ) hücreleri açılan pencere ile açtığım çalışma kitabına yapıştıramadım.

File dilog ile seçme nedenim çalışma kitabının (deney123 veya deney120390 gibi adı değişiyor) günlük deney adından sonraki isimleri değişken olduğu için otomatik filedilog ile ile seçiyorum. Fakat iç sayfalarda bir değişkenlik yok(çalışma kitaplarındaki isimler değişse bile satır1 sayfası sabit).

İstediğim makronun çalıştığı ana çalışma kitabındaki l2 den itibaren dolu olan L hücresini kopyalayıp seçmiş olduğum çalışma kitabının l4 hücresinden itibaren değerler olarak yapıştırması aşağıdaki kodu revize etmeme yardımcı olur musunuz



Dim ikinci, ilk As Workbook
Dim Hucre2, Hucre1 As Range

Set ikinci = Application.ActiveWorkbook
Set ikinci = Application.ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "D:\Belgelerim\Downloads\deney*"
.Filters.Clear
.Filters.Add "Excel 2003-2019", "*.xls; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show

If .SelectedItems.Count > 0 Then
Application.Workbooks.Open .SelectedItems(1)
Set ikinci = Application.ActiveWorkbook
' SendKeys "{ENTER}", True
ilk.Activate
Set Hucre2 = Application.InputBox(prompt:="Kopyalamak İstediğiniz Hücreleri Seçin", Title:=Baslik, Default:="L2: L1000 (son dolu hücreye kadar olacak)", Type:=8)
ikinci.Activate
'SendKeys "{ENTER}", True
Set Hucre1 = Application.InputBox(prompt:="Yapıştıracağınız Yeri Seçin", Title:=Baslik, Default:="'Satır1'!$L$4", Type:=8)
Hucre2.Copy Hucre1
Hucre2.CurrentRegion.EntireColumn.AutoFit
'ikinci.Close False
End If
End With


Tşk.ler

 

[Muzaffer Ali]

Merhaba.

Deneyiniz.

Sub test()
    Dim Init As String
    Init = "D:\Belgelerim\Downloads\deney*"
    Range("L2:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy
    With Application.FileDialog(msoFileDialogOpen)
        If (Dir(Init, vbDirectory)) <> "" Then .InitialFileName = Init
        .Filters.Clear
        .Filters.Add "Excel 2003-2019", "*.xls; *.xlsm; *.xlsx"
        .AllowMultiSelect = False
        .Show
        
        If .SelectedItems.Count > 0 Then
            Application.Workbooks.Open(.SelectedItems(1)).Worksheets("Sayfa1").Range("L4").PasteSpecial Paste:=xlPasteValues
        End If
    End With
    MsgBox "Kopyalama tammalandı."
End Sub

 

[ufukufuk01]

Merhaba.

Deneyiniz.

Sub test()
    Dim Init As String
    Init = "D:\Belgelerim\Downloads\deney*"
    Range("L2:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy
    With Application.FileDialog(msoFileDialogOpen)
        If (Dir(Init, vbDirectory)) <> "" Then .InitialFileName = Init
        .Filters.Clear
        .Filters.Add "Excel 2003-2019", "*.xls; *.xlsm; *.xlsx"
        .AllowMultiSelect = False
        .Show
       
        If .SelectedItems.Count > 0 Then
            Application.Workbooks.Open(.SelectedItems(1)).Worksheets("Sayfa1").Range("L4").PasteSpecial Paste:=xlPasteValues
        End If
    End With
    MsgBox "Kopyalama tammalandı."
End Sub

Hocam teşekkür ederim.

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.