PDA

View Full Version : changing range



cenderus
10-05-2008, 07:22 AM
Sub VERİLERİ_G?NCELLE()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Documents and Settings\admin\Desktop\ANA DOSYA\1"
Set S1 = Workbooks("ANA DOSYA.xls").Sheets("Sayfa1")
S1.Select
[A2:B65536].ClearContents
Set Klas?r = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klas?r
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "ANA DOSYA.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa1").Select
Range("E2:E" & [E65536].End(3).Row).Copy S1.Cells(65536, 1).End(3).Offset(1)
Range("G2:G" & [G65536].End(3).Row).Copy S1.Cells(65536, 2).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub


at this code it takes e and g columns only but i want to change it to range a29-fd65536 how can i do this

Bob Phillips
10-05-2008, 07:59 AM
What part of the task do you want to start at A29?

cenderus
10-05-2008, 08:04 AM
i want to change

Range("E2:E" & [E65536].End(3).Row).Copy S1.Cells(65536, 1).End(3).Offset(1)
Range("G2:G" & [G65536].End(3).Row).Copy S1.Cells(65536, 2).End(3).Offset(1)


this part to only one value range

range a29-fd65536
colomn a to fd
row 29 to 65536

cenderus
10-05-2008, 08:37 AM
Sub VERİLERİ_G?NCELLE()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Documents and Settings\admin\Desktop\ANA DOSYA\1"
Set S1 = Workbooks("ANA DOSYA.xls").Sheets("sheet1")
S1.Select
[A29:FD65536].ClearContents
Set Klas?r = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klas?r
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "ANA DOSYA.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("sheet1").Select
Range("A29:FD" & [FD65536].End(3).Row).Copy S1.Cells(65536, 1).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub

i solve it but now i have another problem;

how can i add more than one sheet

sheet1 to sheet1
sheet2 to sheet2
sheet3 to sheet3
sheet4 to sheet4

cenderus
10-05-2008, 09:42 AM
i change code like this but now it takes more time to copy the pages to pages i have 52 sheets at 4 files to update weekly at mail file ;

is there any easy way to do this



Sub VERİLERİ_G?NCELLE()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Documents and Settings\admin\Desktop\ANA DOSYA\1\"
Set S1 = Workbooks("ANA DOSYA.xls").Sheets("Sayfa1")
S1.Select
[A29:FD6000].ClearContents
Set Klas?r = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klas?r
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "ANA DOSYA.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa1").Select
Range("A29:FD6000" & [FD6000].End(3).Row).Copy S1.Cells(6000, 1).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Set S1 = Workbooks("ANA DOSYA.xls").Sheets("Sayfa2")
S1.Select
[A29:FD6000].ClearContents
Set Klas?r = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klas?r
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "ANA DOSYA.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa2").Select
Range("A29:FD6000" & [FD6000].End(3).Row).Copy S1.Cells(6000, 1).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub