Autofilter, copy & paste vba not working

eviehc123

New Member
Joined
Jan 21, 2019
Messages
32
Hi can someone have a look at the below and help with why it's not working?

Warning it's messy!

Code:
Sub Searchproper()
'
' copyandpaste Macro
'


'
    Sheets("HR Advice & Admin").Select
    FilterString = Sheets("Offer Received").Range("G5").Value
    ActiveSheet.Range("$A$1:$AS$286").AutoFilter Field:=1, Criteria1:=FilterString
    Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("B:B")).Copy
    Sheets("Offer Received").Range("B5").PasteSpecial xlPasteValues
    Intersect(.AutoFilter.Range.Offset(1), .Range("C:c")).Copy
    Sheets("Offer Received").Range("B10").PasteSpecial xlPasteValues
    Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("D:d")).Copy
    Sheets("Offer Received").Range("B12").PasteSpecial xlPasteValues
    Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("E:e")).Copy
    Sheets("Offer Received").Range("B14").PasteSpecial xlPasteValues
    Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("F:f")).Copy
    Sheets("Offer Received").Range("B16").PasteSpecial xlPasteValues
    Intersect(.AutoFilter.Range.Offset(1), .Range("G:g")).Copy
    Sheets("Offer Received").Range("E8").PasteSpecial xlPasteValues
    Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("H:h")).Copy
    Sheets("Offer Received").Range("E10").PasteSpecial xlPasteValues
    Range("I2:I" & Cells(Rows.Count, "I").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("I:i")).Copy
    Sheets("Offer Received").Range("E12").PasteSpecial xlPasteValues
    Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("J:j")).Copy
    Sheets("Offer Received").Range("E14").PasteSpecial xlPasteValues
    Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("K:k")).Copy
    Sheets("Offer Received").Range("E18").PasteSpecial xlPasteValues
    Range("L2:L" & Cells(Rows.Count, "L").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("L:l")).Copy
    Sheets("Offer Received").Range("E20").PasteSpecial xlPasteValues
    Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("M:m")).Copy
    Sheets("Offer Received").Range("H8").PasteSpecial xlPasteValues
    Range("N2:N" & Cells(Rows.Count, "N").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("N:n")).Copy
    Sheets("Offer Received").Range("H10").PasteSpecial xlPasteValues
    Range("P2:P" & Cells(Rows.Count, "P").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("P:p")).Copy
    Sheets("Offer Received").Range("H14").PasteSpecial xlPasteValues
    Range("Q2:Q" & Cells(Rows.Count, "Q").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("Q:q")).Copy
    Sheets("Offer Received").Range("H20").PasteSpecial xlPasteValues
    Range("R2:R" & Cells(Rows.Count, "R").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("R:r")).Copy
    Sheets("Offer Received").Range("B23").PasteSpecial xlPasteValues
    Range("S2:S" & Cells(Rows.Count, "S").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("S:s")).Copy
    Sheets("Offer Received").Range("B25").PasteSpecial xlPasteValues
    Range("T2:T" & Cells(Rows.Count, "T").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("T:t")).Copy
    Sheets("Offer Received").Range("B27").PasteSpecial xlPasteValues
    Range("U2:U" & Cells(Rows.Count, "U").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("U:u")).Copy
    Sheets("Offer Received").Range("B29").PasteSpecial xlPasteValues
    Range("V2:V" & Cells(Rows.Count, "V").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("V:v")).Copy
    Sheets("Offer Received").Range("E23").PasteSpecial xlPasteValues
    Range("W2:W" & Cells(Rows.Count, "W").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("W:w")).Copy
    Sheets("Offer Received").Range("E25").PasteSpecial xlPasteValues
    Range("X2:X" & Cells(Rows.Count, "X").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("X:x")).Copy
    Sheets("Offer Received").Range("E27").PasteSpecial xlPasteValues
    Range("Y2:Y" & Cells(Rows.Count, "Y").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
    Intersect(.AutoFilter.Range.Offset(1), .Range("Y:y")).Copy
    Sheets("Offer Received").Range("E29").PasteSpecial xlPasteValues
    Sheets("HR Advice & Admin").Select
    Selection.AutoFilter
    Sheets("Offer Received").Select
    Application.CutCopyMode = False
End Sub

Thanks!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
You're welcome & thanks for the feedback
 
Upvote 0
Hi! now I want to do the reverse as above. I want to copy everything from "Offer Received" back to "HR Advice & Admin" once the complete button is clicked.

I want the autofilter to filter based on cell G5. If the autofilter brings up data then I want the form to copy and paste in that row replacing any data. If the autofilter doesn't bring anything up because it is new data then I want the information from the "Offer Received" page to paste on the next available row. Please see below what I have so far:

Code:
Sub CompleteForm1()
'
' CompleteForm1 Macro
'


'
     With Sheets("HR Advice & Admin")
      FilterString = Sheets("Offer Received").Range("G5").Value
      .Range("$A$1:$AS$286").AutoFilter Field:=1, Criteria1:=FilterString
      Sheets("Offer Received").Range("B8").Copy
      Sheets("HR Advice & Admin").Intersect(.AutoFilter.Range.Offset(1), .Range("A:A")).PasteSpecial xlPasteValues
      Sheets("Offer Received").Range("B5").Copy
      Sheets("HR Advice & Admin").Intersect(.AutoFilter.Range.Offset(1), .Range("B:B")).PasteSpecial xlPasteValues
      Sheets("Offer Received").Range("B10").Copy
      Sheets("HR Advice & Admin").Intersect(.AutoFilter.Range.Offset(1), .Range("C:C")).PasteSpecial xlPasteValues
      .AutoFilterMode = False
      End With
      Sheets("Offer Received").Select
    Application.CutCopyMode = False
End Sub
I know the above doesn't work.

This is what I have to paste on the next available row:
Code:
Sub Button21_Click()
'
' Button21_Click Macro
'


'
    
      Sheets("Offer Received").Range("B12").Copy
      Sheets("HR Advice & Admin").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub

I want them both in the one code please.

Thank you!
 
Upvote 0
How about
Code:
Sub CompleteForm1()
'
' CompleteForm1 Macro
'
Dim FilterString As String

'
     With Sheets("HR Advice & Admin")
         FilterString = Sheets("Offer Received").Range("G5").Value
         .Range("$A$1:$AS$286").AutoFilter Field:=1, Criteria1:=FilterString
         Sheets("Offer Received").Range("B8").Copy
         On Error GoTo NoVisible
         .Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1).PasteSpecial xlPasteValues
         Sheets("Offer Received").Range("B5").Copy
         .Range("B2:B" & Rows.Count).SpecialCells(xlVisible)(1).PasteSpecial xlPasteValues
         Sheets("Offer Received").Range("B10").Copy
         .Range("C2:C" & Rows.Count).SpecialCells(xlVisible)(1).PasteSpecial xlPasteValues
         On Error GoTo 0
         .AutoFilterMode = False
      End With
      Sheets("Offer Received").Select
      Application.CutCopyMode = False
      Exit Sub
NoVisible:
   Sheets("Offer Received").Range("B12").Copy
   Sheets("HR Advice & Admin").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Sheets("HR Advice & Admin").AutoFilterMode = False
   Sheets("Offer Received").Select
   Application.CutCopyMode = False
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top