VBA code - Copy / paste first visible cell after filter applied

[Radek1]

Dears,

I would like to kindly ask you for your help with vba code for copying first visible cells after filtering.
I have vba which copy / paste everytime value from one fixed cell (A9)....now as need to update file and more variables appearing, I need to copy first visible cell under header (A8)

Old vba code...
Worksheets("Cover sheet").Range("M17").Value = Worksheets("Kamil Deml").Range("A9").Value

I believe, for you no any problem

Thanks in advance

Rregads

Radek

 

[steve the fish]

Try to change this to suit what you need:

crit = 2 'change

With Sheets("Sheet1") 'change
    If .AutoFilterMode Then .AutoFilterMode = False
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr < 9 Then Exit Sub
    With .Range("A8:A" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=crit
        If .SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Offset(1, 0).Resize(lr - 1).SpecialCells(xlCellTypeVisible).Cells(1).Copy
        End If
    End With
    .AutoFilterMode = False
End With

 

[Radek1]

Hi,

Thank you for your advice. I'm real beginner in VBA and tried to fit to whole code chain but no success...I'm pretty sure that your code works, but it's by my hands
Whole code chain is linked to click button. I just need to copy data from one sheet to another for these (in red color)...rest is working (I did not create that code at all, just request from my boss to update for mentioned problem...

Sub Button2_Click()


Dim rng As Range, cel As Range
On Error Resume Next
Set rng = Range("B9:B" & Cells(Rows.Count, "B").End(3).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
If cel <> rng(1) Or cel(1, 2) <> rng(1, 2) Then
MsgBox " More then one supplier / initiative selected " & vbCrLf & " See cell(s) " & cel.Address(0, 0) & " and/or " & cel(1, 2).Address(0, 0)
cel.Select
Exit Sub
End If
Next


Worksheets("Kamil Deml").Range("E9:E10000").Copy
Worksheets("Cover sheet").Cells(27, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False


Worksheets("Kamil Deml").Range("F9:F10000").Copy
Worksheets("Cover sheet").Cells(27, 6).PasteSpecial xlPasteValues
Application.CutCopyMode = False


Worksheets("Kamil Deml").Range("G9:G10000").Copy
Worksheets("Cover sheet").Cells(27, 7).PasteSpecial xlPasteValues
Application.CutCopyMode = False


Worksheets("Kamil Deml").Range("Q9:Q10000").Copy
Worksheets("Cover sheet").Cells(27, 15).PasteSpecial xlPasteValues
Application.CutCopyMode = False


Worksheets("Kamil Deml").Range("N9:N10000").Copy
Worksheets("Cover sheet").Cells(27, 19).PasteSpecial xlPasteValues
Application.CutCopyMode = False




Worksheets("Cover sheet").Range("M17").Value = Worksheets("Kamil Deml").Range("A9").Value
Worksheets("Cover sheet").Range("G8").Value = Worksheets("Kamil Deml").Range("C9").Value
Worksheets("Cover sheet").Range("G10").Value = Worksheets("Kamil Deml").Range("B9").Value
Worksheets("Cover sheet").Range("G12").Value = Worksheets("Kamil Deml").Range("J9").Value


Worksheets("Cover sheet").Select
Worksheets("Cover sheet").Range("A1:A1").Select


End If






LastRow = Sheets("Kamil Deml").Cells(Sheets("Kamil Deml").Rows.Count, "A").End(xlUp).Row
Filter_count = Sheets("Kamil Deml").Range("A9", Sheets("Kamil Deml").Cells(LastRow, 1)).Rows.SpecialCells(xlCellTypeVisible).Count


If Filter_count > 40 Then

For i = 1 To Filter_count - 40
Worksheets("Cover sheet").Cells(28, 2).EntireRow.Insert


Next i
End If
End Sub

Try to change this to suit what you need:

crit = 2 'change

With Sheets("Sheet1") 'change
    If .AutoFilterMode Then .AutoFilterMode = False
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr < 9 Then Exit Sub
    With .Range("A8:A" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=crit
        If .SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Offset(1, 0).Resize(lr - 1).SpecialCells(xlCellTypeVisible).Cells(1).Copy
        End If
    End With
    .AutoFilterMode = False
End With