Move data from Master sheet to various sheets based on criteria I have a master

Question

Move data from Master sheet to various sheets based on criteria

I have a master sheet that I would like to have auto fill a row of data into other worksheet based on criteria found in a column.

Example of Master....

So basically I want to say if the "Code" = 0901 put all data for that row (92128756, 0901, 003, X*, 692554) into one worksheet named 0901 and if Code = 5501 put all that data into another worksheet named 5501.

Explanation / Answer

Revised code - copy and replace your existing code with this. Shouldn't even need changes to the Const values (but double-check me).

Explanation: Looks at code - tries what once worked and now fails, scratches head. Starts to try to develop work-around, suddenly SMACKS FOREHEAD! and mumbles to self "you idiot".

The problem is we are trying to copy an entire row which would go from column A out to the last possible column -- but I was trying to paste it into the destination sheet beginning at column B, not A! That generates the error because Excel realizes I'm an idiot but is too polite to just come out with it as "Error 1004: Programmer is Idiot".

Here's the revised code, let me know if it works better now. Once again, I've tested it here and it does for me. And I even threw in one group of merged cells just to be on the safe side. I added a little code and changed our problem line a little, and I've made those bold also just to point them out.

Sub MoveData()
   'How to put this code into your workbook:
   ' http://www.contextures.com/xlvba01.html#Regular
   'change these Const values to match your main data sheet setup
   Const dataWSName = "Master"
   Const dataCodeCol = "B" ' column with the 0901/5501 codes in it
   Const dataFirstRow = 2 ' first row with data to copy

   Dim srcWS As Worksheet
   Dim destWS As Worksheet
   Dim codesListRange As Range
   Dim anyCode As Range
   Dim newWSName As String
   Dim lastRow As Long
   Dim whereAmI As String
   Dim offsetToColA As Integer
  
   whereAmI = ActiveSheet.Name
   offsetToColA = _
    Range("A1").Column - Range(dataCodeCol & 1).Column ' -1 for now
   Set srcWS = ThisWorkbook.Worksheets(dataWSName)
   lastRow = srcWS.Range(dataCodeCol & Rows.Count).End(xlUp).Row
   If lastRow < dataFirstRow Then
     lastRow = dataFirstRow
   End If
   Set codesListRange = srcWS.Range(dataCodeCol & dataFirstRow & _
    ":" & dataCodeCol & lastRow)
   Application.ScreenUpdating = False
   For Each anyCode In codesListRange
     newWSName = Trim(anyCode.Text)
     On Error Resume Next
     'see if needed sheet exists, if not create it
     Set destWS = ThisWorkbook.Worksheets(newWSName)
     If Err <> 0 Then
       Err.Clear
       On Error GoTo 0
       'the sheet doesn't exist, create it
       ThisWorkbook.Worksheets.Add _
        after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
       ActiveSheet.Name = newWSName
       Set destWS = ThisWorkbook.Worksheets(newWSName)
     End If
     On Error GoTo 0
     anyCode.EntireRow.Copy _
      destWS.Range(dataCodeCol & Rows.Count).End(xlUp).Offset(1, offsetToColA)
     Application.CutCopyMode = False
   Next
   'back to the sheet you started on
   ThisWorkbook.Worksheets(whereAmI).Activate
   MsgBox "Data has been copied to appropriate sheets.", vbOKOnly, "Done!"
   'good housekeeping cleanup
   Set codesListRange = Nothing
   Set destWS = Nothing
   Set srcWS = Nothing
End Sub

Related Questions

Navigate

• Browse (All)
• Browse M
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.