veri aktarımı

[emk35]

Bir konu var arkadaşlar sitenin potansiyeline göre basit bir konu.. ilgilenirseniz sevinirim.. dosya ekledim. içinde açıkladım.. biraz acill. ilgilenen herkese şimdiden teşekkürler...

 

[emk35]

veri aktarımı.. acill..

:biggrin:Konu site sakinlerine çok basit geldi herhalde ilgilenen yok...:biggrin:

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub grub1()
Dim S1 As Worksheet, S2 As Worksheet, STR As Long
Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
S2.Range("A:C").ClearContents
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("A2:C" & STR).Copy S2.Range("A1")
Application.ScreenUpdating = True
End Sub
Sub grup2()
Dim S1 As Worksheet, S2 As Worksheet, STR As Long
Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa3")
Application.ScreenUpdating = False
S2.Range("A:C").ClearContents
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("A2:B" & STR).Copy S2.Range("A1")
S1.Range("D2:D" & STR).Copy S2.Range("C1")
Application.ScreenUpdating = True
End Sub

 

[emk35]

sayın asi kral teşekkür ediyorum ellerinize sağlık..

Fakat karşısı boş olan ay isimlerini 2. veya3. almamasını da istiyorum bu konuda yardımcı olur musunuz yeniden.. Teşekkürler..

 

[asi_kral]

Sizce almıyor mu_?

 

[emk35]

Yani demek istediğim 2. ve 3. sayfalarda 12 ayın olmaması ocak şubat nisan haziran ağustos eylül kasım 2. sayfada diğerleri 3. sayfada olması..

 

[asi_kral]

Yani demek istediğim 2. ve 3. sayfalarda 12 ayın olmaması ocak şubat nisan haziran ağustos eylül kasım 2. sayfada diğerleri 3. sayfada olması..

İstediğiniz boş olanların aktarılmaması mı_?
Kodları bununla değiştirip dener misiniz_?

Option Explicit
Sub grub1()
Dim S1 As Worksheet, S2 As Worksheet, STR As Long
Dim ÇLŞS As String, ÇLŞH As Variant
Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
ÇLŞS = ActiveSheet.Name
S2.Cells.Delete
S2.Select: ÇLŞH = ActiveCell.Address
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("A2:C" & STR).AutoFilter 3, ">0"
S1.Range("A2:C" & STR).Copy
S2.Range("A1").PasteSpecial (xlPasteValues)
S1.Range("A2:D" & STR).AutoFilter
Range(ÇLŞH).Select
Sheets(ÇLŞS).Select
Application.ScreenUpdating = True
End Sub
Sub grup2()
Dim S1 As Worksheet, S2 As Worksheet, STR As Long
Dim ÇLŞS As String, ÇLŞH As Variant
Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa3")
Application.ScreenUpdating = False
ÇLŞS = ActiveSheet.Name
S2.Cells.Delete
S2.Select: ÇLŞH = ActiveCell.Address
STR = S1.Range("A" & Rows.Count).End(xlUp).Row
S1.Range("A2:D" & STR).AutoFilter 4, ">0"
S1.Range("A2:B" & STR).Copy
S2.Range("A1").PasteSpecial (xlPasteValues)
S1.Range("D2:D" & STR).Copy
S2.Range("C1").PasteSpecial (xlPasteValues)
S1.Range("A2:D" & STR).AutoFilter
Range(ÇLŞH).Select
Sheets(ÇLŞS).Select
Application.ScreenUpdating = True
End Sub

 

[emk35]

Asi kral 1967 Çok Teşekür ederim ellerinize sağlık

 

[asi_kral]

Asi kral 1967 Çok Teşekür ederim ellerinize sağlık

Kolay Gelsin.

 

[Metin_S]

Merhaba,

Benim sorunum biraz daha farklı yardımcı olabilirseniz sevinirim. 2 ayrı excel dosyası var. liste.xls olanda A1 hücresinden başlayarak değerler var. tablo.xls içinde makro ile bu değerleri I11 hücresinden başlayarak almasını istiyorum. Örnek ektedir. Şimdiden teşekkürler.

 

[asi_kral]

Merhaba,

Benim sorunum biraz daha farklı yardımcı olabilirseniz sevinirim. 2 ayrı excel dosyası var. liste.xls olanda A1 hücresinden başlayarak değerler var. tablo.xls içinde makro ile bu değerleri I11 hücresinden başlayarak almasını istiyorum. Örnek ektedir. Şimdiden teşekkürler.

Merhaba
Sorunuzun bu konu ile alakasını çözümedim ama yanıt vereyim genede.
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub veri_al()
Dim XCL As Application, KTP As Workbook
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, YOL As String, ÇLŞ As Variant
Application.ScreenUpdating = False
Set XCL = CreateObject("Excel.Application")
ÇLŞ = ActiveCell.Address
XCL.Visible = False
Set S1 = Sheets("rapor")
YOL = ThisWorkbook.Path & "\"
Set KTP = XCL.Workbooks.Open(YOL & "liste.xls")
Set S2 = KTP.Sheets("Sayfa1")
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A1:A" & STR).Copy
S1.Range("I11").PasteSpecial (xlPasteValues)
KTP.Close: XCL.Quit
Range(ÇLŞ).Select
Application.ScreenUpdating = True
End Sub

 

[Metin_S]

Sayın asi_kral_1967 merhaba, konu başlığı veri aktarma olduğu için buraya mesaj yazdım ayrı bir konu açmak istemedim. İlginiz için teşekkür ederim. Oldu çok sağolun

 

[asi_kral]

Sayın asi_kral_1967 merhaba, konu başlığı veri aktarma olduğu için buraya mesaj yazdım ayrı bir konu açmak istemedim. İlginiz için teşekkür ederim. Oldu çok sağolun

Kolay Gelsin.