Solved VBA Conditional Copy of Data

August 28, 2011 at 02:34:49
Specs: Windows 7

I'm trying to copy some data from one worksheet to another (conditionally).

In the master worksheet, I have a lot of data in rows and columns.
One of the columns has specific information (names) and I'm trying to copy only certain rows/columns based on whats in the "names" column.

1 John Blue Play Bulb
2 Jack Black Run Toy
3 Dave Brown Home Desk
4 Jack Grey Work Door
5 Brian Green Shed Chair

I want code that copies all rows that contain "Jack" in column A to a new worksheet. The worksheet should be named "Jack" and only certain columns should be copied, such as columns A, and C.
Therefore the new worksheet (Jack) will be:
1 Jack Run
2 Jack Work

Does anyone know how I can achieve this?

I have been using bits and pieces code from this website to try and get this to work but to no avail!

I found some logic but keep getting error: "Runtime error '9': Subscript out of range."
This is a start and I can build on it if I can get it working!

I'm using Excel 2010.

Option Explicit
Private Sub cmdGetData_Click()
Dim lastListRow, myItems, destRow As Long
Dim shtName As String

'Determine how many rows from Sheet1 to copy
lastListRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through rows
For myItems = 2 To lastListRow
'Set Sheet name based on value in Sheet1 Column A for each list item
shtName = Sheets(1).Range("A" & myItems)
'Determine next empty row in Sheet with the same name
'as the value in Sheet1 Column A
destRow = Sheets(shtName).Range("A" & Rows.Count).End(xlUp).Row
'Copy current list item to proper sheet
Rows(myItems).EntireRow.Copy _
Destination:=Sheets(shtName).Range("A" & destRow)

End Sub

See More: VBA Conditional Copy of Data

Report •

August 28, 2011 at 09:13:22
First, before you post any more data or code in this forum, please click on the blue line at the end of this post and read the instructions found via that link.

Second, "Runtime error '9': Subscript out of range." typically means that VBA can't find the object that it is looking for. For example, if you are trying to paste something into a sheet named Jack, and there is no sheet named Jack, VBA will show that error.

Third, since you seem to be willing to learn some of this VBA stuff on your own, read Response # 6 of this thread:

In order to use the Single Step feature, you may have to change the name of your macro to something else temporarily so that is not a "Click" macro.

Something like Sub CopyMyData() or anything like that.

If you still have trouble getting it to work, come on back and we'll see what we can do for you.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

August 28, 2011 at 10:00:32
Thanks DerbyDad03.

I'll use the "pre" tags from now on.

I found a solution (sort of) that I've had to change slightly to adapt to my needs.

The code was on this site in another reply:

  Option Explicit

Private Sub cmdGenIOTbls_Click()
  Dim rngStart As Range
  Dim rngEnd As Range
  Dim rngCell As Range
  Dim rngDestEnd As Range
  Dim strWsName As String

On Error GoTo ErrHnd

'turn off screen updating to stop flicker
  Application.ScreenUpdating = False

'set start of data (range containing names/numbers for worksheets)
  Set rngStart = Worksheets("master").Range("A6")

'set end of range
  Set rngEnd = Worksheets("master").Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'Loop through all cells with sheet names/numbers
  For Each rngCell In Range(rngStart, rngEnd)
    'get name/number
     strWsName = rngCell.Text
   On Error Resume Next
      If Worksheets(strWsName) Is Nothing Then
      'worksheet does not exist, so create & name it
         On Error GoTo ErrHnd
        'create new sheet
          Worksheets.Add After:=Worksheets(Worksheets.Count)
        'name new sheet
          Worksheets(Worksheets.Count).Name = strWsName
      End If
    'if name was valid for a worksheet, copy 5 cells to that named sheet
    'find empty row after end of destination data
      Set rngDestEnd = Worksheets(strWsName).Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)
      rngCell.Resize(1, 5).Copy
      rngDestEnd.PasteSpecial (xlPasteValuesAndNumberFormats)
  Next rngCell
'restore screen updating
  Application.ScreenUpdating = True
  Exit Sub

'error handler
'restore screen updating
  Application.ScreenUpdating = True

End Sub

However, this still copies the entire range row. I haven't figured out how to copy only certain columns for a particular range of rows.

I know I'll have to make a change to this line:

rngCell.Resize(1, 5).Copy

But I don't know what the correct code should be!

Any suggestions on where to look?


Report •

August 28, 2011 at 13:13:21
✔ Best Answer
If rngCell was e.g. Set to A6 this would copy C6:

rngCell.Offset(0, 2).Copy

Offset is 0 Rows from Row 6 and 2 Columns from Column A

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

Related Solutions

Ask Question