filtrelenen değerleri makroyla başka bir excele aktarmak

[borsaturk]

arkadaşlar merhaba.

şube adı ya da şube koduna göre bir taslak çalışması yaptım. ben burada örneğin adana şubeyi ilgilendiren a1 den e8 e kadar olan alanı alıp başka bir sheete kopyalamak istiyorum.bunu makroyla yapmalıyım cunku data çok büyük.bu sadece bir kısmı.

bunu diğer şube adları/kodları icin de yapmam gerekiyor.yani şube adı adana olanlar ayrı bir sheete. bursa olanlar ayrı bir sheete gibi.

nasıl yapabilirim.desteklerinizi rica ediyorum.hepinize çok teşekkür ederim yardımlarınız icin sağolun.

 

[antonio]

Sayfa1 in sekmesine sağ tıklayıp, açılan menülerden "Kod görüntüle" seçeneğine tıklayınız. Açılan kod penceresine aşağıdaki kodları aynen yapıştırınız. Örnek dosyanız eklenmiştir, inceleyiniz.

Dim s1 As Worksheet, s2 As Worksheet, ss As Long, alan As Range, aranan As String

Set s1 = Sayfa1:    Set s2 = Sayfa2
Set alan = s1.Range("A3:E3")
aranan = "*" & TextBox1.Text & "*"

If aranan = "" Then
    If alan.FilterMode Then
      alan.ShowAllData
      alan.AutoFilter
    End If
ElseIf aranan <> "" Then
    Application.ScreenUpdating = False
    s2.Cells.ClearContents
    alan.AutoFilter field:=2, Criteria1:=aranan
    ss = s1.Range("B" & Rows.Count).End(3).Row
    s1.Range("A2:E" & ss).SpecialCells(xlCellTypeVisible).Copy s2.Range("A2")
    Application.ScreenUpdating = True
End If
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With Sayfa1
    .TextBox1.Height = .Range("B1").Height
    .TextBox1.Width = .Range("B1").Width
    .TextBox1.Top = .Range("B1").Top
    .TextBox1.Left = .Range("B1").Left
    .TextBox1.Value = ""
End With
End Sub

 

[numan şamil]

Merhaba
Alternatif olsun
Beklentinizi karşılar mı bilmiyorum
Bu forumdan aldığım kodları dosyanıza uyarlamaya çalıştım
ekli dosyayı incelermisiniz

 

[borsaturk]

Merhaba
Alternatif olsun
Beklentinizi karşılar mı bilmiyorum
Bu forumdan aldığım kodları dosyanıza uyarlamaya çalıştım
ekli dosyayı incelermisiniz

çok teşekkür ederim numan bey. saygılarımla.