Search code examples
excelvbacellworksheet

Copy Data with Matching Worksheet Name


I have a workbook containing worksheets "Summary" (where all data are consolidated, as shown), "8","9","10".
Fig.1

I want to copy the data from "Summary" with the condition that if cell in Column A contains the worksheet name (8, 9 or 10), that cell's row and Column C to E will pasted to the worksheet with matching name.
Fig.2

The pasted data will be offset to row 7, and each datum will be incremented with a space. For example, cells in Column A rows 2 to 6 in "Summary" contains "8", thus Columns C to E rows 2 to 6 will be copied and pasted to sheet "8".

Link to my macro file: https://drive.google.com/file/d/18UalCvxIXuP6imVWZsWLRZPghMqogZp8/view?usp=sharing

This code won't do the offset and increment:

Sub Copy_Data()
Application.ScreenUpdating = False
Dim i As Long
Dim j As Double
Sheets("Summary").Activate
Dim lastrow As Long
lastrow = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Dim ans As String

For i = 2 To lastrow
    ans = Cells(i, "A").Value
    Lastrowa = Sheets(ans).Cells(Rows.Count, "C").End(xlUp).Row
    Sheets("Summary").Rows(i).Columns("C:E").Copy
    Sheets(ans).Rows(Lastrowa + 1).Columns("C:E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
Application.ScreenUpdating = True
End Sub

Solution

  • Sub Copy_Data()
        Dim lastRow As Long, offsetRow As Long, i As Long, No As String, NOSheet As Worksheet, auxRow As Long, summarySheet As Worksheet
        Set summarySheet = Worksheets("Summary")
        lastRow = summarySheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        offsetRow = 7
        For i = 2 To lastRow
            No = Cells(i, "A")
            Set NOSheet = Worksheets(No)
            auxRow = NOSheet.Columns("C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
            If auxRow > 1 Then auxRow = auxRow + 2
            If auxRow = 1 Then auxRow = offsetRow
            NOSheet.Cells(auxRow, "C") = summarySheet.Cells(i, "C")
            NOSheet.Cells(auxRow, "D") = summarySheet.Cells(i, "D")
            NOSheet.Cells(auxRow, "E") = summarySheet.Cells(i, "E")
        Next i
    End Sub