Makro düzgün çalışmıyor!!!

O

ockucukay

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
862
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
02-07-2025
Merhaba arkadaşlar

Aşağıdaki makro F8 ile (adımla) düzgün çalışmasına rağmen atadığım düğmeden tıkladığımda parçaya göre süzme işini yapmıyor!!! Kafayı yiyeceğim, neden olur ki? Örnek dosyayı ekledim.Yardımlarınızı bekliyorum, kodu aşağıda veriyorum...

Sub VerialmaxXxx()
Application.ScreenUpdating = False
Sheets("Data").Visible = True
Application.Calculation = xlCalculationManual
Sheets("Data").Select
Columns("A:J").ClearContents
If Sheets("Liste").Range("n1") = 5 Then
Application.ScreenUpdating = False
'Sheets("Data").Visible = True
Application.Calculation = xlCalculationManual
Sheets("Data").Select
Columns("A:J").ClearContents
Dim kriter1 As String
Dim kriter2 As String
kriter1 = Range("l1").Value
kriter2 = Range("l2").Value
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=server-06;UID=sa;APP=Microsoft Office XP;DATABASE=SQL9000_SERVER_2006_1;Trusted_Connection=Yes" _
, Destination:=Range("A1"))
.CommandText = "SELECT HATA_ANALIZI_VIEW.[TARİH], HATA_ANALIZI_VIEW.[ÜRÜN KODU], HATA_ANALIZI_VIEW.[OPERASYON ADI], HATA_ANALIZI_VIEW.[ÜRETİLEN MİKTAR], Ayar, Ayar_neden, Ekis, Ekis_neden, Hurda, Hurda_neden FROM SQL9000_SERVER_2006_1.dbo.HATA_ANALIZI_VIEW WHERE [TARİH]>='" + kriter1 + "' And [TARİH]<= '" + kriter2 + "' ORDER BY [TARİH]"
.Name = "server-06 kaynağından sorgula"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
'Sheets("Liste").Visible = True
Sheets("Liste").Select
Sheets("Liste").Rows(Range("L1").Value).Copy
Sheets("Liste").Range("A112").PasteSpecial Paste:=xlPasteValues
Sheets("Ana Sayfa").Select
Range("D3").Select
'Sheets("Data").Visible = xlVeryHidden
'Sheets("Liste").Visible = xlVeryHidden
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
Application.ScreenUpdating = False
Sheets("Data").Select
Range("O2:O100").Select
Selection.ClearContents
Sheets("Liste").Select
Range("A2:A28").Select
Selection.Copy
Sheets("Data").Select
Range("O2").Select
ActiveSheet.Paste
Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("O1:O28"), CopyToRange:=Range("R1"), Unique:=False
Columns("A:J").Select
Selection.ClearContents
Columns("R:AA").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("R:AA").Select
Application.CutCopyMode = False
Selection.ClearContents
End If
If Sheets("Liste").Range("n1") = 11 Then
Call VerialmaxXxx1
Application.ScreenUpdating = False
Sheets("Data").Select
Range("O2:O100").Select
Selection.ClearContents
Sheets("Liste").Select
Range("A30:A31").Select
Selection.Copy
Sheets("Data").Select
Range("O2").Select
ActiveSheet.Paste
Columns("A:J").Select
Selection.Copy
Columns("R:R").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("O1:O3"), CopyToRange:=Range("R1:AA1"), Unique:=False
Columns("A:J").Select
Selection.ClearContents
Columns("R:AA").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("R:AA").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
End If
If Sheets("Liste").Range("n1") = 4 Then
Call VerialmaxXxx1
Application.ScreenUpdating = False
Sheets("Data").Select
Range("O2:O100").Select
Selection.ClearContents
Sheets("Liste").Select
Range("A35:A37").Select
Selection.Copy
Sheets("Data").Select
Range("O2").Select
ActiveSheet.Paste
Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("O1:O4"), CopyToRange:=Range("R1"), Unique:=False
Columns("A:J").Select
Selection.ClearContents
Columns("R:AA").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("R:AA").Select
Application.CutCopyMode = False
Selection.ClearContents
End If
If Sheets("Liste").Range("n1") = 12 Then
Call VerialmaxXxx1
Application.ScreenUpdating = False
Sheets("Data").Select
Range("O2:O100").Select
Selection.ClearContents
Sheets("Liste").Select
Range("A41:A44").Select
Selection.Copy
Sheets("Data").Select
Range("O2").Select
ActiveSheet.Paste
Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("O1:O5"), CopyToRange:=Range("R1"), Unique:=False
Columns("A:J").Select
Selection.ClearContents
Columns("R:AA").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("R:AA").Select
Application.CutCopyMode = False
Selection.ClearContents
End If
If Sheets("Liste").Range("n1") = 6 Then
Call VerialmaxXxx1
Application.ScreenUpdating = False
Sheets("Data").Select
Range("O2:O100").Select
Selection.ClearContents
Sheets("Liste").Select
Range("A46:A102").Select
Selection.Copy
Sheets("Data").Select
Range("O2").Select
ActiveSheet.Paste
Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("O1:O56"), CopyToRange:=Range("R1"), Unique:=False
Columns("A:J").Select
Selection.ClearContents
Columns("R:AA").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("R:AA").Select
Application.CutCopyMode = False
Selection.ClearContents
End If
If Sheets("Liste").Range("n1") >= Sheets("Liste").Range("G1") Then
Dim kriterx1 As String
Dim kriterx2 As String
Dim kriterx3 As String
kriterx1 = Range("l1").Value
kriterx2 = Range("l2").Value
kriterx3 = Range("m2").Value
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=server-06;UID=sa;APP=Microsoft Office XP;DATABASE=SQL9000_SERVER_2006_1;Trusted_Connection=Yes" _
, Destination:=Range("A1"))
.CommandText = "SELECT HATA_ANALIZI_VIEW.[TARİH], HATA_ANALIZI_VIEW.[ÜRÜN KODU], HATA_ANALIZI_VIEW.[OPERASYON ADI], HATA_ANALIZI_VIEW.[ÜRETİLEN MİKTAR], Ayar, Ayar_neden, Ekis, Ekis_neden, Hurda, Hurda_neden FROM SQL9000_SERVER_2006_1.dbo.HATA_ANALIZI_VIEW WHERE [TARİH]>='" + kriterx1 + "' And [TARİH]<= '" + kriterx2 + "' And [ÜRÜN KODU]= '" + kriterx3 + "' ORDER BY [TARİH]"
.Name = "server-06 kaynağından sorgula"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
End If
Sheets("Liste").Visible = True
Sheets("Liste").Select
Sheets("Liste").Rows(Range("L1").Value).Copy
Sheets("Liste").Range("A112").PasteSpecial Paste:=xlPasteValues
Sheets("Ana Sayfa").Select
Range("D3").Select
'Sheets("Data").Visible = xlVeryHidden
'Sheets("Liste").Visible = xlVeryHidden
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub VerialmaxXxx1()
Application.ScreenUpdating = False
'Sheets("Data").Visible = True
Application.Calculation = xlCalculationManual
Sheets("Data").Select
Columns("A:J").ClearContents
Dim kriter1 As String
Dim kriter2 As String
kriter1 = Range("l1").Value
kriter2 = Range("l2").Value
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=server-06;UID=sa;APP=Microsoft Office XP;DATABASE=SQL9000_SERVER_2006_1;Trusted_Connection=Yes" _
, Destination:=Range("A1"))
.CommandText = "SELECT HATA_ANALIZI_VIEW.[TARİH], HATA_ANALIZI_VIEW.[ÜRÜN KODU], HATA_ANALIZI_VIEW.[OPERASYON ADI], HATA_ANALIZI_VIEW.[ÜRETİLEN MİKTAR], Ayar, Ayar_neden, Ekis, Ekis_neden, Hurda, Hurda_neden FROM SQL9000_SERVER_2006_1.dbo.HATA_ANALIZI_VIEW WHERE [TARİH]>='" + kriter1 + "' And [TARİH]<= '" + kriter2 + "' ORDER BY [TARİH]"
.Name = "server-06 kaynağından sorgula"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
'Sheets("Liste").Visible = True
Sheets("Liste").Select
Sheets("Liste").Rows(Range("L1").Value).Copy
Sheets("Liste").Range("A112").PasteSpecial Paste:=xlPasteValues
Sheets("Ana Sayfa").Select
Range("D3").Select
'Sheets("Data").Visible = xlVeryHidden
'Sheets("Liste").Visible = xlVeryHidden
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
O

ockucukay

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
862
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
02-07-2025
Dosyayı eklememişim özür özür...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst