Copy rows to other sheets based on value in column [Solved/Closed]

Question

Copy rows to other sheets based on value in column [Solved/Closed]

Report

LeedMe

Posts: 6
Registration date: Tuesday March 28, 2017
Status: Member
Last seen: April 12, 2018

- Updated on Mar 28, 2017 at 07:47 AM
vcoolio

Posts: 1269
Registration date: Thursday July 24, 2014
Status: Moderator
Last seen: January 4, 2021

- Mar 30, 2017 at 08:59 AM

All,
I have an Excel file with three sheets: Sheet1 contains all my data. Sheet2 named "MACH" and Sheet3 named "FAB"
I am looking for a way with a macro, to run upon opening the Excel document, and look in column "G" of Sheet1 for the values "MACH" and "FAB. If "MACH" is found in "G" then it copies the row into the sheet named "MACH" and if "FAB" is found in "G" then copy that row to the sheet named "FAB".
When the information is copied I would like it to be inserted into the next available row in the "MACH" and "FAB" sheets so there are no row spaces.
I have attempted the task by looking around forums but, I can only get it half way there.

First macro I have is:
Sub SortDepartments()
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "MACH." Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy

Sheets("MACH").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next
End Sub

Second macro removes the empty rows:
Private Sub Auto_Open(ByVal Target As Range)
If Intersect(Target, Columns("G:G")) Is Nothing Then Exit Sub
If Target.Value = "MACH." Then
Target.EntireRow.Copy Sheets("MACH").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

End If
End Sub

Excel copy row to another sheet based on cell value
Excel copy row to another sheet based on cell value formula - Best answers
Copy row to another sheet based on cell value - Best answers
Excel move row to another sheet based on cell value ✓ - Forum - Excel
Transfer Data From One Excel Sheet to Another - How-To - Excel
Excel move row to another sheet based on cell value without macro ✓ - Forum - Excel
Copy Rows from one sheet to others based on a condition ✓ - Forum - Office Software
Excel copy row to another sheet based on cell value without macro ✓ - Forum - Excel

6 replies

Answer 2 / 6

vcoolio

Posts: 1269
Registration date: Thursday July 24, 2014
Status: Moderator
Last seen: January 4, 2021

214
Mar 29, 2017 at 07:56 PM

Sorry LeedMe, try this link instead:-

https://www.dropbox.com/s/h8v8w6b6zaofr3f/LeedMe%28Master%20sht%20to%20multi%20shts%29.xlsm?dl=0

Cheerio,
vcoolio.

Answer 3 / 6

btcoutermash
Mar 30, 2017 at 06:56 AM

That Excel sheet works great!
The issue I have now is that when I try to use that macro on my existing document I get an error. Also can it not delete the the data on Sheet1? I would still need that sheet for multitude of reasons.
This is a slimmed down copy of my document.
I appreciate the help!!
https://www.dropbox.com/s/fpns1c7fy6w8myc/BACKLOG_TEST.xlsm?dl=0

Answer 4 / 6

vcoolio

Posts: 1269
Registration date: Thursday July 24, 2014
Status: Moderator
Last seen: January 4, 2021

214
Mar 30, 2017 at 07:55 AM

Hello btcoutermash,

I assume that you are the same Poster (LeedMe).

Following is the code adjusted to suit your workbook:-


Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        
ar = Array("MACH", "FAB")
  
Application.ScreenUpdating = False
Application.DisplayAlerts = False

  For i = 0 To UBound(ar)
         Sheet3.Range("G7", Sheet3.Range("G" & Sheet3.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
         lr = Sheet3.Range("G" & Rows.Count).End(xlUp).Row
         If lr > 1 Then
         Sheet3.Range("G8", Sheet3.Range("G" & Sheet3.Rows.Count).End(xlUp)).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
         Sheets(ar(i)).Columns.AutoFit
         End If
    Next i
Sheet3.[G7].AutoFilter

Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

One of the reasons that you may have received an error is because you placed a full stop after "MACH" in the array. The code would not have recognised this as a criteria as the input sheet has "MACH" not "MACH." For the same reason, the code would not have recognised a sheet named "MACH." In your case, sheet names and criteria must be spelt exactly the same.

Another reason would be that the sheet code for your Sheet1(your input sheet) is actually Sheet3. You'll notice that in the adjusted code above I have altered this for you.

Another reason would be that your data begins in row 8 with headings in row 7. The sample I supplied has the data begining in row 2 with headings in row 1. I have adjusted this also for you.

I have also removed the delete line of code.

Test the adjusted code in a copy of your work book first.

I hope that this helps.

cheerio,
vcoolio.

Answer 5 / 6

LeedMe

Posts: 6
Registration date: Tuesday March 28, 2017
Status: Member
Last seen: April 12, 2018

Mar 30, 2017 at 08:49 AM

Yes, that is I. Sorry about the confusion I was not logged in when I replied.
That works prefect. I will study the results to try and better understand how the code works..
I do appreciate it!!

Answer 6 / 6

vcoolio

Posts: 1269
Registration date: Thursday July 24, 2014
Status: Moderator
Last seen: January 4, 2021

214
Mar 30, 2017 at 08:59 AM

Hello LeedMe,

You're welcome. Glad that I was able to help.

Come back any time should you need any further help or clarification.

Cheerio,
vcoolio.

Ask a question

vcoolio · Accepted Answer · 2017-03-29T19:51:11-0400

Hello LeedMe,

Try the following code in a copy of your work book first:-


Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        
ar = Array("MACH", "FAB")
  
Application.ScreenUpdating = False
Application.DisplayAlerts = False

  For i = 0 To UBound(ar)
         Sheet1.Range("G1", Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
         lr = Sheet1.Range("G" & Rows.Count).End(xlUp).Row
         If lr > 1 Then
         Sheet1.Range("A2", Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
         Sheet1.Range("A2", Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)).Delete
         Sheets(ar(i)).Columns.AutoFit
         End If
    Next i
[G1].AutoFilter

Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

The code filters Column G for the criteria "MACH" and "FAB" and then, when found, transfers the relevant row of data to the relevant sheet. The "used" data in the main sheet is then deleted. You'll note that in the code above, I have used the sheet code rather than the sheet name.

Following is the link to a sample that I have prepared for you. Download the sample and then click on the "RUN" button to see it work.

https://www.dropbox.com/s/h8v8w6b6zaofr3f/LeedMe%28Master%20sht%20to%20multi%20shts%29.xlsm?dl=0

I hope that this helps.

Cheerio,
vcoolio.

Copy rows to other sheets based on value in column [Solved/Closed]

6 replies

Your reply

Subscribe To Our Newsletter!