If call value in master sheet equals Tab name, copy rows with that name value into Tab

[mbkinzer]

Hi guys!

I currently have a workbook that has a master tab (ACCTHX) and a tab created for every member. The ACCTHX tab has a line for each member and each month (so one member will have 12 lines- sometimes more). I need to copy and paste their 12 or more rows (columns D:H) into their corresponding tab into a specific cell (G4). Any help would be appreciated!

This is what I currently have but is bombing out:

Dim wkSht As Worksheet
Dim numrow As Long
Range("A1").Select
numrow = Range(Selection, Selection.End(xlDown)).Count
Range("A1").Value = numrow
For Each wkSht In Sheets
If ActiveSheet.Range(numrow).Value = wkSht.Name Then
ActiveSheet.Range("D:H").CurrentRegion.Copy Destination:=wkSht.Range("G4")

 

[mbkinzer]

Will this work? Copy to G4 and so on

Sub Copy2Tab()

Dim NameX$
Dim eRow&, nRow&
Dim cell As Range, rngName As Range
Dim wsACCTHX As Worksheet, wsX As Worksheet

Set wsACCTHX = ActiveWorkbook.Sheets("ACCTHX")

Application.ScreenUpdating = False

' Find Last row of name list and define range
eRow = wsACCTHX.Range("A1").End(xlDown).Row
Set rngName = wsACCTHX.Range("A1", "A" & eRow)

For Each cell In rngName
    NameX = cell.Value2
    ' Add sheet with name if not yet exist at the most right sheet
    If Not GotTab(NameX) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = NameX
    End If
    Set wsX = ActiveWorkbook.Sheets(NameX)
    ' Find last row with item in target sheet
    nRow = 4
    If Not Len(wsX.Range("G" & nRow)) = 0 Then
        nRow = wsX.Range("G" & wsX.Cells.Rows.Count).End(xlUp).Row
        nRow = nRow + 1
    End If
    ' Write data to sheet
    wsACCTHX.Range("D" & cell.Row, "H" & cell.Row).Copy
    wsX.Range("G" & nRow).PasteSpecial (xlPasteValues)                ' Here it is writing to colmun A in designated sheet
Next

End Sub

Function GotTab(strName As String) As Boolean

Dim ws As Worksheet

GotTab = False
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = strName Then
        GotTab = True
    End If
Next

End Function

Wow! That worked perfectly!! I can not thank you enough!

 

[Zot]

Wow! That worked perfectly!! I can not thank you enough!

Glad it worked. Thanks for update