Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Excel'e Yeni Başlayanlar (http://www.excel.web.tr/forumdisplay.php?f=14)
-   -   Makro ile Özel Yapıştır (http://www.excel.web.tr/showthread.php?t=169046)

schlecht 18-12-2017 07:56

Makro ile Özel Yapıştır
 
merhaba,

dosya_adi = Yol & "\" & k_dosya_adi & ".xlsx"
Set K2 = Excel_Uygulama.Workbooks.Open(dosya_adi)
Set S1 = K2.Worksheets("Sheet1")
Son = S1.Range("C:C").Cells.SpecialCells(xlCellTypeConst ants).Count
'MsgBox (Son)

S1.Range(k_range & Son).Copy K1.Sheets(kontrol_noktasi_kodu).Range(c_baslangic)
K2.Close False

kapalı iki dosya arası veri kopyalamak için kullandığım kod bu şekilde, bu koda özel yapıştır kodunu nasıl ekleyebilirim ?

kopyalanan veriyi değer olarak yapıştırmak istiyorum.

Bir de sola hizalanabilir mi böyle bit şey mümkün mü?

Teşekkürler..

asri 18-12-2017 08:08

Aşağıdaki şekilde deneyiniz.

Kod:

dosya_adi = Yol & "\" & k_dosya_adi & ".xlsx"
Set K2 = Excel_Uygulama.Workbooks.Open(dosya_adi)
Set S1 = K2.Worksheets("Sheet1")
Son = S1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).Count
'MsgBox (Son)

S1.Range(k_range & Son).Copy Destination:=K1.Sheets(kontrol_noktasi_kodu).Range(c_baslangic).PasteSpecial Paste:=xlPasteValues
K2.Close False


schlecht 18-12-2017 08:16

Maalesef hata verdi.

asri 18-12-2017 08:52

Bende test edemedim.
Bir de bu şekilde deneyin. Kod güncellendi.


schlecht 18-12-2017 09:23

Malesef yine hata verdi. Tamamını paylaşmsam daha yararlı olacak gibi. "PasteSpecial Paste:" ile çözemedim bir türlü sorunu.. İlginize teşekkür ederim...

Sub Kopyala()
'
' Kopyala Makro
'
' Klavye Kısayolu: Ctrl+x

Dim K1 As Object, K2 As Object, S1 As Worksheet, Son As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Excel_Uygulama = CreateObject("Excel.Application")
Excel_Uygulama.Visible = False

' 1 ------------------------------------------------
MsgBox ("Kaynak dosyaların olduğu klasörü seçin")

kaynak_path = GetFolder("C:\")

'Yol = ActiveWorkbook.Path
Yol = kaynak_path

' 2 -------------------------------------------------
MsgBox ("Çalışma kağıdını seçin")

calisma_kagidi = GetFile("C:\")

Set K1 = Excel_Uygulama.Workbooks.Open(calisma_kagidi)

For Each c In ActiveSheet.Range("A3:a34").Cells

If c.Value = "Evet" Then
For Each cc In ActiveSheet.Range("A" & c.Row & ":j" & c.Row).Cells
If cc.Column = 3 Then
kontrol_noktasi_kodu = cc.Value
ElseIf cc.Column = 4 Then
c_baslangic = cc.Value
ElseIf cc.Column = 8 Then
k_dosya_adi = cc.Value
ElseIf cc.Column = 9 Then
k_range_start = cc.Value
ElseIf cc.Column = 10 Then
k_range_end = cc.Value
End If

Next cc

k_range = k_range_start & ":" & k_range_end

dosya_adi = Yol & "\" & k_dosya_adi & ".xlsx"
Set K2 = Excel_Uygulama.Workbooks.Open(dosya_adi)
Set S1 = K2.Worksheets("Sheet1")
Son = S1.Range("C:C").Cells.SpecialCells(xlCellTypeConst ants).Count
'MsgBox (Son)


S1.Range(k_range & Son).Copy K1.Sheets(kontrol_noktasi_kodu).Range(c_baslangic)
K2.Close False


End If
Next c

K1.Save
K1.Close True

Set S1 = Nothing
Set K1 = Nothing
Set K2 = Nothing
Set Excel_Uygulama = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
'
End Sub

schlecht 18-12-2017 16:58

Biraz karmaşık oldu sanırım...

schlecht 30-01-2018 19:28

Yardımcı olabilicek olan var mı ? Çıkamadım işin içinden

schlecht 31-01-2018 14:59

// GÜncel//

Korhan Ayhan 01-02-2018 01:37

Kopyalama işlemini yapan satırı aşağıdaki gibi değiştirip deneyiniz.

Kod:

S1.Range(k_range & Son).Copy
K1.Sheets(kontrol_noktasi_kodu).Range(c_baslangic).PasteSpecial Paste:=xlPasteValues
Selection.HorizontalAlignment = xlLeft


schlecht 01-02-2018 09:42

İlginize teşekkür ederim.

Selection.HorizontalAlignment = xlLeft

burda hata aldım.


Saat 20:05

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.