Soru Makro ile sadece görünür satıları kopyalama

Katılım
6 Ağustos 2017
Mesajlar
98
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
11-03-2020
İyi akşamlar. Bir veri kopyalama makrom var. Bu makro Sayfadaki gizli satırları da kopyalıyor. Ben sadece görünür satırları kopyalamasını istiyorum. Yardımcı olabilir misiniz nasıl bir şey eklemem lazım makroma?
Kod:
Sub VERİLERİKAYDET22()

'İlk başta boş olan hücreleri gizliyorum'
Dim s1 As Worksheet, a(), adres As Range
Dim brn, i As Integer
Set s1 = Sheets("Veri Kaynağı")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
s1.Rows.EntireRow.Hidden = False
a = s1.Range("H2:H" & s1.Cells(Rows.Count, 8).End(3).Row).Value
For i = 1 To UBound(a)
If a(i, 1) = 0 Then
brn = brn + 1
If brn = 1 Then: Set adres = Cells(i + 1, 1)
If brn > 1 Then: Set adres = Union(adres, Cells(i + 1, 1))
End If
Next i
If brn > 0 Then adres.EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Erase a: adres = Empty: Set s1 = Nothing: brn = Empty: i = Empty

'Sonra Kalan satırları kopyalamak istiyorum ama gizli satırları da seçiyor. Ben sadece Görünür satırları kopyalamak İstiyorum'
Workbooks.Open Filename:= _
"\\ank1mrkekm53\ORTAK\1- BÜLTENLER\Nöb. Müd\2019\Veri Havuzu.xlsm"
Windows("Nöb. Müd. Program v2.xlsm").Activate
Sheets("Veri Kaynağı").Select
Range("B2:M5943").Select
Selection.Copy

'İlgili yere yapıştırıyorum'
Windows("Veri Havuzu.xlsm").Activate
Sheets("Ocak").Select
Range("A65535").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Veri Havuzu.xlsm").Activate
ActiveWorkbook.Save
ActiveWindow.Close

'Gizlediğim satırları tekrar görünür hale getiriyorum'
With Sheets("Veri Kaynağı").Select
Rows("2:6000").EntireRow.Hidden = False
End With
Sheets("Veri Aktarımı").Select
End Sub
 

turist

Destek Ekibi
Destek Ekibi
Katılım
18 Kasım 2009
Mesajlar
5,102
Excel Vers. ve Dili
2013 64Bit
English
Workbooks.Open Filename:= _
"\\ank1mrkekm53\ORTAK\1- BÜLTENLER\Nöb. Müd\2019\Veri Havuzu.xlsm"
Windows("Nöb. Müd. Program v2.xlsm").Activate
Sheets("Veri Kaynağı").Select
Range("B2:M5943").Select
Selection.SpecialCells(xlCellTypeVisible).Copy

şeklinde deneyin.
 
Katılım
6 Ağustos 2017
Mesajlar
98
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
11-03-2020
Workbooks.Open Filename:= _
"\\ank1mrkekm53\ORTAK\1- BÜLTENLER\Nöb. Müd\2019\Veri Havuzu.xlsm"
Windows("Nöb. Müd. Program v2.xlsm").Activate
Sheets("Veri Kaynağı").Select
Range("B2:M5943").Select
Selection.SpecialCells(xlCellTypeVisible).Copy

şeklinde deneyin.
Evet tam ihtiyacım olan kod. Çok teşekkür ederim. Her zamanki gibi çok yardımcı oldunuz ????
 

turist

Destek Ekibi
Destek Ekibi
Katılım
18 Kasım 2009
Mesajlar
5,102
Excel Vers. ve Dili
2013 64Bit
English
Sağ olun, iyi çalışmalar.
 
Üst