Add a new Rows based on cell value to match with tab name

[Hopy]

Hi All

I need to add new rows with data from "Sheet 8" to "Sheet 1", "Sheet 2" and "Sheet 3", based on the column A cell value of "Sheet 8". If the cell value is matched with the tab name, e.g. Sheet 1, then the whole row of content will be copied to the worksheet "Sheet 1" from next empty row as there is a existing data in all worksheets. The number of rows in "Sheet 8" is unknown.
There is a solution what i found in this forum, but new values are replace old one and not added on the next empty rows

Copy Rows based on cell value to match with tab name

Hi All I need to copy the row data from "Sheet 8" to "Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4" and "Sheet 5" based on the column A cell value of "Sheet 8". If the cell value is matched with the tab name, e.g. Sheet 1, then the whole row of content will be copied to the worksheet "Sheet 1"...

www.mrexcel.com

I wonder is anyone able to help. Many thanks.

 

[vcoolio]

Hello Hopy,

It's a little different to the other thread but see if this works for you:-

Option Explicit
Sub Test()

    Dim ar As Variant, i As Long
    ar = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7")
   
    Application.ScreenUpdating = False
   
            For i = 0 To UBound(ar)
                    With Sheet8.[A1].CurrentRegion
                            .AutoFilter 1, ar(i), 7
                            .Offset(1).Resize(.Rows.Count - 1).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
                            .AutoFilter
                    End With
            Next i
   
    Application.ScreenUpdating = True

End Sub

The code assumes that you have headings in row1 with data starting in row2.

I hope that this helps.

Cheerio,
vcoolio.

P.S. Did you want to delete the rows from Sheet8 once the data transfer is completed? If you don't, you'll have many duplicates in the destination sheets.
The other option, if you need to keep all the data in Sheet8, would be to clear all the destination sheets prior to any data transfer. We can add an additional line of code for either option.

 

[Hopy]

Thx forks great!

 

[vcoolio]

You're welcome Hopy. I'm glad to have been able to assist.

Cheerio,
vcoolio

 

[Hopy]

You're welcome Hopy. I'm glad to have been able to assist.

Cheerio,
vcoolio

Hello, there is one more problem detected.
If in Sheet8 A2 row, i set "Sheet1" Value, then run macro, Sheet1 tab will be works great, but Sheet2-Sheet3-ETC, will be copied all values from Sheet8 where A rows isnt empty, i mean copied with tab header etc etc.
I make Code modification for my needs, but your functianility wasnt touched with my hands...

Option Explicit
Sub Ad()
Dim c As Long
Dim myRange As Range
Dim myCell As Range
Dim lastrow As Integer
Dim ar As Variant, i As Long
lastrow = Sheet8.Cells(1, 23).Value

Set myRange = Range("A1:F" & lastrow)

For Each myCell In myRange
    If IsEmpty(myCell) Then
        c = c + 1
    End If
Next myCell
If c > 0 Then

 MsgBox "NO DATA!"
            Exit Sub
            End If
    

    ar = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    
    Application.ScreenUpdating = False

 

            For i = 0 To UBound(ar)
                    With Sheet8.[A1].CurrentRegion
    .Value = .Value
    
  
                            .AutoFilter 1, ar(i), 7
                            .Offset(1).Resize(.Rows.Count - 1).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
                            .AutoFilter
                    End With
            Next i
    
    
    
Worksheets("Sheet8").Range("A2:G100").Clear
Worksheets("Template").Range("Done").Copy Destination:=Worksheets("Sheet8").Range("A2:G2")
MsgBox ("Done")
Application.ScreenUpdating = True
End Sub

 

[vcoolio]

Hello Hopy,

I have no idea as to what you are trying to do. The additional code you have added is interfering with the one supplied to you in post #2 and I don't know what it is supposed to do.
The code in post #2, according to your response, does exactly what you wanted it to do.

If you need further help with this, then I suggest that you upload a sample of your workbook using a file sharing site such as Drop Box or WeTransfer or use the XL2BB file uploader which you'll find in the ribbon at the top of the reply box. We'll also need you to fully explain what you are attempting to do and show inputs with expected outputs.

If your request is for a new issue, then please start a new thread.

Cheerio,
vcoolio.