İki ayrı makroyu tek makro altında birleştirmek

[ecalhan]

Arkadaşlar merhaba, 2 ayrı makroya sahibim ve bunları tek bir makro altında birleştirmek istiyorum. İlki Pivottable ile ilgili ve bunun devamında data sayfasındaki CX5I205 arasındaki değerleri dj5u205 arasına kopyalayarak remove dublicate edecek ayrı bir vba var. İlkini sayfa değişimi ile tetikleyebiliyorum ancak ikincisinde bunu gercekleştiremediğim için ilkinin peşine eklemek istedim. Call ile cagırdığımda ne yazıkki calıstıramadım. Bunu tek bir çatı altında nasıl birleştirebilirim ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
If Intersect(Target, Worksheets("Sheet1").Range("b4:b5")) Is Nothing Then Exit Sub

Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets("Sheet1").Range("b4").Value

With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With

Dim ws As Worksheet
Dim Rng1 As Range

Set ws = Worksheets("Data")
Set Rng1 = ws.Range("CX5I205")

Rng1.Copy
ws.Range("dj5u205").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
For sut = 114 To 125 ' A sütunundan E sütununa kadar
adres = ws.Range(Cells(5, sut), Cells(Cells(Rows.Count, sut).End(3).Row, sut)).Address(0, 0)
ws.Range(Cells(5, sut), Cells(Cells(Rows.Count, sut).End(3).Row, sut)).RemoveDuplicates (1), xlNo
Next

End Sub

 

[YUSUF44]

Buna uygun örnek dosya paylaşır mısınız?

 

[ecalhan]

Merhaba söz konusu dosya ektedir. Destek olacak arkadaşlara şimdiden teşekkür ederim.

 

[ecalhan]

Merhaba herkese konuyu asagıdaki kod ile cozdum. Diüer arkadaşlarında bilgisi olması ıcın vba kodlarını paylaşıyorum.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Worksheets("Sheet1").Range("b4:b5")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to suit your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets("Sheet1").Range("b4").Value

'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Data")

Worksheets("Data").Activate
ws.Range("CX5I205").Select
Selection.Copy
ws.Range("DJ5U205").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


ws.Range("DJ5U205").RemoveDuplicates Columns:=Array(1), Header:=xlNo

End Sub