DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub test()
aaa = Sheets("Sayfa1").[b65536].End(3).Row
Sheets("Sayfa1").Range("a1:b" & aaa).Copy
[e1].Select
Paste
Application.CutCopyMode = False
End Sub
Sub Düğme1_Tıklat()
[a1:a30].SpecialCells(2, 23).Copy [c1]
End Sub
Sub dolu_satirlar()
Dim hcr As Range, a As Integer
Range("C1:C2000").ClearContents
ReDim myarr(1 To 1, 1 To 1)
For Each hcr In Range("A1:B1000")
If hcr.Value <> "" Then
a = a + 1
ReDim Preserve myarr(1 To 1, 1 To a)
myarr(1, a) = hcr.Value
End If
Next hcr
Application.ScreenUpdating = False
If a > 0 Then [C1].Resize(a, 1) = Application.Transpose(myarr)
Application.ScreenUpdating = True
Erase myarr
MsgBox "C sütununa A ve B sütunundaki ilk 1000 dolu hücre C sütunna listelendi"
End Sub
@Seyit Tiken hocamÖrnek kodu kendinize uyarlayın.Kod:Sub Düğme1_Tıklat() [a1:a30].SpecialCells(2, 23).Copy [c1] End Sub