tek sütuna birden fazla sütundan veri aktarımı

[filizu]

merhaba, excel'i pek bilmiyorum. Şöyle bir sorunum var... 30 sütun ve 24 satırdan oluşan sayısal verileri yine excel tabanında hazırlanmış başka bir programa aktarırken tek bir sütun halinde alt alta eklemem gerekiyor. bunu kısa yoldan nasıl yapabilirim? o kadar çok veri var ki sütun sütun taşımak çok uzun zaman alıyor....
şimdiden teşekkür ediyorum
filiz
Ek dosyası olarak antalya iklim verileri dosyasındaki AB 37 den Ab 60'a kadar olan sütunun ardından Ac 37'den 60'a.........BD 37-60 tüm veriler diğer dosyadaki F sütununa eklenmesi gerekiyor, kısaca yapabileceğim bir yöntem varmıdır

 

[mancubus]

bu isteğiniz macro ile olabilir.
macro kullanımını bilmiyorsanız sitede arama yaparak destek alınız.
mutlaka dosyalarınızın bir yedeğini alınız.

aşağıdaki kodu "antalya-iklim verileri.xls" dosyasında iken alt+f11 tuşları ile açacağınız kod pencererinde standart bir modüle kopyalayınız. (insert - module)

Sub OneColumn()
' Jason Morin as amended by Doug Glancy (as amended by Mancubus @ www.excel.web.tr)
' http://makeashorterlink.com/?M19F26516
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length
'into 1 continuous column in a new sheet
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set ws_from = Worksheets.Add
ws_from.Name = "çok sütun"

Sheets("antalya-2008-sıcaklık").Select
Range("AB37").Select 'kopyalanacak sütunlar AB37 hücresinden başlamalı
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ws_from.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

from_lastcol = ws_from.Cells(1, Columns.Count).End(xlToLeft).Column

On Error Resume Next

Set ws_to = Worksheets.Add
ws_to.Name = "tek sütun"

For from_colndx = 1 To from_lastcol
    from_lastrow = ws_from.Cells(Rows.Count, from_colndx).End(xlUp).Row
    If from_lastrow + ws_to.Cells(Rows.Count, 1).End(xlUp).Row <= 65536 Then
        to_lastrow = ws_to.Cells(Rows.Count, 1).End(xlUp).Row
    Else
        MsgBox "This time you've gone to far"
        Exit Sub
    End If
    ws_from.Range(ws_from.Cells(1, from_colndx), ws_from.Cells(from_lastrow, _
      from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

ws_to.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Dim wb As Workbook
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks("H:\excel çalışma\Antalya-climatefile.xls") 'kendi dosyanızın yoluna uyarlayın
On Error GoTo 0


If wb Is Nothing Then
   Workbooks.Open ("H:\excel çalışma\Antalya-climatefile.xls")
Else
   wb.Activate
End If

Sheets("WAC").Select
Range("F10:F" & Range("F65536").End(3).Row).ClearContents

Windows("antalya-iklim verileri.xls").Activate
Sheets("tek sütun").Select
Range("A1:A" & Range("A65536").End(3).Row).Copy Destination:=Workbooks("Antalya-climatefile.xls").Sheets("WAC").Range("F10")
Range("F10").Select

Windows("antalya-iklim verileri.xls").Activate
Application.DisplayAlerts = False
ws_from.Delete
ws_to.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End Sub

 

[halit3]

merhaba, excel'i pek bilmiyorum. Şöyle bir sorunum var... 30 sütun ve 24 satırdan oluşan sayısal verileri yine excel tabanında hazırlanmış başka bir programa aktarırken tek bir sütun halinde alt alta eklemem gerekiyor. bunu kısa yoldan nasıl yapabilirim? o kadar çok veri var ki sütun sütun taşımak çok uzun zaman alıyor....
şimdiden teşekkür ediyorum
filiz
Ek dosyası olarak antalya iklim verileri dosyasındaki AB 37 den Ab 60'a kadar olan sütunun ardından Ac 37'den 60'a.........BD 37-60 tüm veriler diğer dosyadaki F sütununa eklenmesi gerekiyor, kısaca yapabileceğim bir yöntem varmıdır

alternatif kod açılan listeden veri alınacak dosyayı seçmeniz yeterli

Sub aktar()
eskidosya_adı = ActiveWorkbook.Name
Dosya = Application.GetOpenFilename("All Files (*.*),*.*.")
If Dosya = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
son = Cells(Rows.Count, "f").End(3).Row
Range("F10:F" & son).ClearContents
Dim wb As Workbook
Set wb = Workbooks.Open(Dosya)
yenidosya_adı = ActiveWorkbook.Name
Sheets.Add
Sheets(ActiveSheet.Name).Select
Sheets(ActiveSheet.Name).Name = "deneme"
    
sat = 10
For r = 7 To Worksheets("antalya-2008-sıcaklık").Cells(Rows.Count, "AA").End(3).Row
If IsNumeric(Sheets("antalya-2008-sıcaklık").Cells(r, "AA").Value) = True Then
For i = 28 To 58
If IsNumeric(Sheets("antalya-2008-sıcaklık").Cells(r, i).Value) = True Then
If Sheets("antalya-2008-sıcaklık").Cells(r, i).Value <> "" Then
Sheets("deneme").Cells(sat, 6).Value = Sheets("antalya-2008-sıcaklık").Cells(r, i).Value
sat = sat + 1
End If
End If
Next i
Else
If IsNumeric(Sheets("antalya-2008-sıcaklık").Cells(r, "AA").Value) = False Then
If Sheets("antalya-2008-sıcaklık").Cells(r, "AA").Value <> "" Then
Sheets("deneme").Cells(sat, 5).Value = Sheets("antalya-2008-sıcaklık").Cells(r - 1, 27).Value
End If
End If
End If
Next r
sat1 = Worksheets("deneme").Cells(Rows.Count, "f").End(3).Row
Worksheets("deneme").Range("F10:F" & sat1).Copy
Windows(eskidosya_adı).Activate
Range("F10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows(yenidosya_adı).Activate
Application.CutCopyMode = False
Application.DisplayAlerts = False
wb.Close False
Range("F10").Select
MsgBox "işlem tamam"
End Sub

 

[halit3]

aslında alternatif kod olmamış Sayın mancubus'un kodu farklı işlem yapıyor benim kodum farklı işlem yapıyor.

 

[mancubus]

aslında alternatif kod olmamış Sayın mancubus'un kodu farklı işlem yapıyor benim kodum farklı işlem yapıyor.

uyarlamamda bir hata yoktur inşallah

 

[halit3]

uyarlamamda bir hata yoktur inşallah

hata olarak düşnmeyin ben o tarafını bilmiyorum yanlızca iki kodda farklı işlemleri yapıyor

Sayın filizu ' nun sorusunu ben başka türlü siz başka türlü yapmışsınız belkide ikiside gerekli olabilir yada sizin yazdığınız kod işini görüyor olabilir.

iyi çalışmalar

 

[mancubus]

hata olarak düşnmeyin ben o tarafını bilmiyorum yanlızca iki kodda farklı işlemleri yapıyor

Sayın filizu ' nun sorusunu ben başka türlü siz başka türlü yapmışsınız belkide ikiside gerekli olabilir yada sizin yazdığınız kod işini görüyor olabilir.

iyi çalışmalar

teşekkürler.

çok sayıda sütundaki verileri alt alta tek bir sütunda toplayarak başka bir yere kopyalamak arada bir ihtiyaç duyduğum bir çalışma. elimde bunun için bir kod bulunduğundan konu benzer diye yorumlamıştım.

maksat arkadaşımızı yanlış yönlendirmiş olmayayım.

 

[filizu]

Çok teşekkür ederim..

 

[halit3]

Çok teşekkür ederim..

iyi çalışmalar

 

[gcaliskan]

tek bir sütunda toplama

Çok sayıda sütundaki verileri alt alta tek bir sütunda toplamaya ben de çok acil ihtiyaç duymaktayım fakat kodu çalıştıramadım. Daha önce kod çalıştırmamış biri olarka yardımcı olabilirseniz memnun olurum. teşekkürler.