VBA help pleasee I have a workbook that has multiple worksheets in it... I\'m wa

Question

VBA help pleasee

I have a workbook that has multiple worksheets in it... I'm wanting to find all rows that are in Sheet3, where the value in Column B matches the value in A2 in sheet2. Then it will copy and paste those rows in the sheet that matches the name of the value in A2 of Sheet2. Then it will loop through all the Cells in Column A in Sheet2 doing the same functions for all of the Cells until it hits a empty Cell in Column A. Below you'll see the names that are in Column A in Sheet2 and you'll also see the worksheets that match the names of each Cell. I've already got a marco to do this...

VBA help pleasee I have a workbook that has multiple worksheets in it... I'm wanting to find all rows that are in Sheet3, where the value in Column B matches the value in A2 in sheet2. Then it will copy and paste those rows in the sheet that matches the name of the value in A2 of Sheet2. Then it will loop through all the Cells in Column A in Sheet2 doing the same functions for all of the Cells until it hits a empty Cell in Column A. Below you'll see the names that are in Column A in Sheet2 and you'll also see the worksheets that match the names of each Cell. I've already got a marco to do this...

Explanation / Answer

Hi,

Sub Copy_Data();
Dim r As Range, LastRow As Long, ws As Worksheet
Dim c As Range, s As String, LastRow1 As Long
Dim src As Worksheet, MyRange As Range
Dim LastRow3 As Long
Set src = Sheets("Sheet3")
LastRow = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet2").Range("A2:A" & LastRow);
LastRow3 = src.Cells(Cells.Rows.Count, "B").End(xlUp).Row;
For Each c In MyRange

For Each r In src.Range("B2:B" & LastRow3)
     If UCase(r.Value) = UCase(c.Value) Then
         On Error Resume Next
         Set ws = Sheets(CStr(r.Value))
         On Error GoTo 0
         If ws Is Nothing Then
             Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r.Value)
             LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, "B").End(xlUp).Row
             src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
             Set ws = Nothing
         Else
             LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, "B").End(xlUp).Row
             src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
             Set ws = Nothing
         End If
     End If
Next r

Next c
End Sub

Related Questions

Navigate

• Browse (All)
• Browse V
• Subjects

---

---

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