Makrolarla verileri cagirmak

[dennisf06]

Ustalarimin sayesinde cok sey ögrendim bu siteden. Ama bir program yapmak istedim icinden cikamadim. Veri sayfasindan baska sayfalara verileri ve veri toplamlarini aktarmak istiyorum.Yardimlariniz icin simdiden cok tesekkür ederim.

 

[dennisf06]

Dosyam ektedir.

 

[dennisf06]

Bir kac bilgiyi eklemek istedim.Levent bey ve Evren bey daha önce bana böyle bir calisma icin kod yazmislardi.Emekleri icin cok tesekkür ederim. Ama veri sayfasini tek indirince bu kodlari uyarlayamadim.Fatura no su ile yapilan sorgulama icin;
Sub rapor()
Dim syf As Worksheet, alan As Range, fat_no As String, hcr_fat_no As String
Dim i As Long, sat As Long, sut As Integer, son_sat As Long, rsat As Long
Sheets("Rapor").Select
Range("A7:E65536").ClearContents
If Sheets("rapor").Range("C3").Value = "" Then
MsgBox "C3 Hücresine Fatura No.su giriniz..!!", vbCritical, "DÝKKAT"
Sheets("Rapor").Range("C3").Select
Exit Sub
End If
rsat = 7
Application.ScreenUpdating = False
For Each syf In Worksheets
If UCase(syf.Name) <> "RAPOR" And UCase(syf.Name) <> "FATURA" Then
sut = syf.Cells(3, 256).End(xlToLeft).Column
For i = 1 To sut Step 3
son_sat = syf.Cells(65536, i).End(xlUp).Row
For sat = 5 To son_sat
If rsat >= 65533 Then
MsgBox "Rapor sayfasýnda sayfa doldu .Diðer kayýtlar raporlanmadý..!!", vbCritical, "DÝKKAT"
GoTo son
End If
fat_no = syf.Cells(sat, i + 1).Value
hcr_fat_no = Sheets("Rapor").Range("C3").Value
If fat_no = hcr_fat_no Then
With Sheets("Rapor")
.Cells(rsat, "A").Value = syf.Name
.Cells(rsat, "B").Value = syf.Cells(3, i).Value
.Cells(rsat, "C").Value = hcr_fat_no
.Cells(rsat, "D").Value = syf.Cells(sat, i).Value
.Cells(rsat, "E").Value = syf.Cells(sat, i + 2).Value
End With
rsat = rsat + 1
End If
Next sat
Next i
End If
Next syf
son:
If rsat > 7 Then Range("A7:E65536").Sort Range("B7")
Application.ScreenUpdating = True
End Sub
Sub trh_rapor()
Dim syf As Worksheet, alan As Range, trh As String, hcr_trh As String
Dim i As Long, sat As Long, sut As Integer, son_sat As Long, rsat As Long
Sheets("Rapor").Select
Range("G7:K65536").ClearContents
If Not IsDate(Sheets("rapor").Range("I3").Value) Then
MsgBox "I3 Hücresine Geçerli bir tarih giriniz..!!" & vbLf & "Örnek : " & Format(Date, "dd.mm.yyyy"), vbCritical, "DÝKKAT"
Sheets("Rapor").Range("I3").Select
Exit Sub
End If
rsat = 7
Application.ScreenUpdating = False
For Each syf In Worksheets
If UCase(syf.Name) <> "RAPOR" And UCase(syf.Name) <> "FATURA" Then
sut = syf.Cells(3, 256).End(xlToLeft).Column
For i = 1 To sut Step 3
son_sat = syf.Cells(65536, i).End(xlUp).Row
For sat = 5 To son_sat
If rsat >= 65533 Then
MsgBox "Rapor sayfasýnda sayfa doldu .Diðer kayýtlar raporlanmadý..!!", vbCritical, "DÝKKAT"
GoTo son
End If
trh = syf.Cells(sat, i).Value
hcr_trh = Sheets("Rapor").Range("I3").Value
If trh = hcr_trh Then
With Sheets("Rapor")
.Cells(rsat, "G").Value = syf.Name
.Cells(rsat, "H").Value = syf.Cells(3, i).Value
.Cells(rsat, "I").Value = syf.Cells(sat, i + 1)
.Cells(rsat, "J").Value = syf.Cells(sat, i).Value
.Cells(rsat, "K").Value = syf.Cells(sat, i + 2).Value
End With
rsat = rsat + 1
End If
Next sat
Next i
End If
Next syf
son:
If rsat > 7 Then Range("G7:K65536").Sort Range("H7")
Application.ScreenUpdating = True
End Sub

Tarih sorgulamasi icinde;
Sub rapor()
Dim syf As Worksheet, alan As Range, fat_no As String, hcr_fat_no As String
Dim i As Long, sat As Long, sut As Integer, son_sat As Long, rsat As Long
Sheets("Rapor").Select
Range("A7:E65536").ClearContents
If Sheets("rapor").Range("C3").Value = "" Then
MsgBox "C3 Hücresine Fatura No.su giriniz..!!", vbCritical, "DÝKKAT"
Sheets("Rapor").Range("C3").Select
Exit Sub
End If
rsat = 7
Application.ScreenUpdating = False
For Each syf In Worksheets
If UCase(syf.Name) <> "RAPOR" And UCase(syf.Name) <> "FATURA" Then
sut = syf.Cells(3, 256).End(xlToLeft).Column
For i = 1 To sut Step 3
son_sat = syf.Cells(65536, i).End(xlUp).Row
For sat = 5 To son_sat
If rsat >= 65533 Then
MsgBox "Rapor sayfasýnda sayfa doldu .Diðer kayýtlar raporlanmadý..!!", vbCritical, "DÝKKAT"
GoTo son
End If
fat_no = syf.Cells(sat, i + 1).Value
hcr_fat_no = Sheets("Rapor").Range("C3").Value
If fat_no = hcr_fat_no Then
With Sheets("Rapor")
.Cells(rsat, "A").Value = syf.Name
.Cells(rsat, "B").Value = syf.Cells(3, i).Value
.Cells(rsat, "C").Value = hcr_fat_no
.Cells(rsat, "D").Value = syf.Cells(sat, i).Value
.Cells(rsat, "E").Value = syf.Cells(sat, i + 2).Value
End With
rsat = rsat + 1
End If
Next sat
Next i
End If
Next syf
son:
If rsat > 7 Then Range("A7:E65536").Sort Range("B7")
Application.ScreenUpdating = True
End Sub
Sub trh_rapor()
Dim syf As Worksheet, alan As Range, trh As String, hcr_trh As String
Dim i As Long, sat As Long, sut As Integer, son_sat As Long, rsat As Long
Sheets("Rapor").Select
Range("G7:K65536").ClearContents
If Not IsDate(Sheets("rapor").Range("I3").Value) Then
MsgBox "I3 Hücresine Geçerli bir tarih giriniz..!!" & vbLf & "Örnek : " & Format(Date, "dd.mm.yyyy"), vbCritical, "DÝKKAT"
Sheets("Rapor").Range("I3").Select
Exit Sub
End If
rsat = 7
Application.ScreenUpdating = False
For Each syf In Worksheets
If UCase(syf.Name) <> "RAPOR" And UCase(syf.Name) <> "FATURA" Then
sut = syf.Cells(3, 256).End(xlToLeft).Column
For i = 1 To sut Step 3
son_sat = syf.Cells(65536, i).End(xlUp).Row
For sat = 5 To son_sat
If rsat >= 65533 Then
MsgBox "Rapor sayfasýnda sayfa doldu .Diðer kayýtlar raporlanmadý..!!", vbCritical, "DÝKKAT"
GoTo son
End If
trh = syf.Cells(sat, i).Value
hcr_trh = Sheets("Rapor").Range("I3").Value
If trh = hcr_trh Then
With Sheets("Rapor")
.Cells(rsat, "G").Value = syf.Name
.Cells(rsat, "H").Value = syf.Cells(3, i).Value
.Cells(rsat, "I").Value = syf.Cells(sat, i + 1)
.Cells(rsat, "J").Value = syf.Cells(sat, i).Value
.Cells(rsat, "K").Value = syf.Cells(sat, i + 2).Value
End With
rsat = rsat + 1
End If
Next sat
Next i
End If
Next syf
son:
If rsat > 7 Then Range("G7:K65536").Sort Range("H7")
Application.ScreenUpdating = True
End Sub

Dosyami kücük bir degistirmeyle tekrar ekliyorum. Yardiminizi rica ediyorum.Tesekkürler.

 

[dennisf06]

Uzman arkadaslardan bir yol g&#246;stermelerini rica ediyorum. Makro bilgim yetersiz oldugu icin makrolar &#252;zerinde nasil bir degisiklik yapacagimi bilemiyorum.