title: Autofilter (or loop) and copy to another workbook based on Cell Value
body: <p>I have a master workbook and a few children simply called <code>Master</code> and <code>Child 1</code>, <code>Child 2</code> and <code>Child 3</code>. Data is filled into <code>Master</code> and needs to be sorted, copied and pasted into the relevant child sheet. The destination of all the child workbooks is the Desktop and the filtering required is simply the name of the required workbook in the first column (which also matches the names of each workbook).</p>
  
  <p>I have attempted this task with the below code, which is what I have been able to pull together from a few places, but with no success. I think, owing to my lack of knowledge, I'm just digging my hole deeper, and the code is beginning to get very long-winded:</p>
  
  <pre><code>Private Sub CommandButton21_Click()
   Dim My_Range As Range
   Dim DestSh As Worksheet
   Dim CalcMode As Long
   Dim ViewMode As Long
   Dim FilterCriteria As String
   Dim CCount As Long
   Dim rng As Range
   Dim strActiveSheet As String
   Dim varCellvalue As String
   Dim fpath As String
   Dim owb As Workbook
  
  varCellvalue = Range("A2").Value
  fpath = "C:\Users\User\Desktop\Templates\" &amp; varCellvalue &amp; "".xlsm"
  strActiveSheet = ActiveSheet.Name
  
  Set My_Range = Range("A1:U" &amp; LastRow(ActiveSheet))
  My_Range.Parent.Select
  
  With Application
      CalcMode = .Calculation
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  ViewMode = ActiveWindow.View
  ActiveWindow.View = xlNormalView
  ActiveSheet.DisplayPageBreaks = False
  
  My_Range.Parent.AutoFilterMode = False
  
  My_Range.AutoFilter Field:=1, Criteria1:="=User 1"
  
  Set owb = Application.Workbooks.Open(fpath)
  Set DestSh = Workbooks(" &amp; varCellvalue &amp; ").Sheets("Work")
  
  CCount = 0
  On Error Resume Next
  CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
  On Error GoTo 0
  If CCount = 0 Then
      MsgBox "There are more than 8192 areas:" _
           &amp; vbNewLine &amp; "It is not possible to copy the visible data." _
           &amp; vbNewLine &amp; "Tip: Sort your data before you use this macro.", _
             vbOKOnly, "Copy to worksheet"
  Else
      With My_Range.Parent.AutoFilter.Range
          On Error Resume Next
  
          Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
                    .SpecialCells(xlCellTypeVisible)
          On Error GoTo 0
          If Not rng Is Nothing Then
  
              rng.Copy
              With DestSh.Range("A" &amp; LastRow(DestSh) + 1)
                  .PasteSpecial Paste:=8
                  .PasteSpecial xlPasteValues
                  .PasteSpecial xlPasteFormats
                  Application.CutCopyMode = False
              End With
              rng.EntireRow.Delete
          End If
      End With
  End If
  My_Range.Parent.AutoFilterMode = False
  
  'Restore ScreenUpdating, Calculation, EnableEvents, ....
  ActiveWindow.View = ViewMode
  Application.Goto DestSh.Range("A1")
  With Application
      .Calculation = xlCalculationAuto
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = CalcMode
      .Calculation = xlCalculationAutomatic
  End With
  Worksheets(strActiveSheet).Activate
  
  End Sub
  
  Function LastRow(sh As Worksheet)
      On Error Resume Next
      LastRow = sh.Cells.Find(What:="*", _
                          After:=sh.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlValues, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
      On Error GoTo 0
  End Function
  </code></pre>
  
  <p>Example data:</p>
  
  <pre><code>Workbook        Requested by ID  Date Raised
  --------------  ---------------  -----------
  Child 1    Ben        10000586       01/01/2015
  Child 2    John       10000587       02/02/2015
  Child 1    Jack       10000588       03/03/2015
  Child 2    Percy      10000589       04/04/2015
  Child 1    Jill       10000590       05/05/2015
  Child 3    George     10000591       06/06/2015
  </code></pre>