Copy each employee row that matches the sheet name into column G transposed

[Mel2016]

Hi,

i am very new at Vba. I not sure I can even do this. I've tried in a macro but it didn't work.

I have a file there are multiple sheets included. One sheet contains a list of employees - that are listed in rows. There are 200+ tabs (5 to exclude), each sheet named with the employee number. I need to copy each the full row of employee data (a1: cv1) to the matching sheet (tab) based on that employee number but copy it into Column G transposed. I created a separate sheet that contains the name of each sheet but don't know how to reference it.

Any help it greatly appreciated!

 

[sericom]

What column is the employee number in? or does your separate sheet have the names and associated numbers?

 

[Mel2016]

Employee number is in column a. Then name in b address in c etc..

 

[sericom]

Try this

Sub populateSheets()
    Set empSheet = Sheets("Employee Sheet")
    lr = empSheet.Range("A" & Rows.Count).End(xlUp).Row
    For Each c In empSheet.Range("A1:A" & lr)
        If wsExists(c.Text) Then
            empSheet.Range("A" & c.Row & ":CV" & c.Row).Copy
            Sheets(c.Text).Range("G1").PasteSpecial Transpose:=True
        Else
            MsgBox "Worksheet " & c.Text & " not found"
        End If
    Next
End Sub

Function wsExists(ByVal sName As String) As Boolean
  wsExists = False
  For Each ws In Worksheets
    If sName = ws.Name Then
      wsExists = True
      Exit Function
    End If
  Next ws
End Function

Change 'Employee Sheet' to the name of your data sheet

 

[Mel2016]

I've tired it but I get an error at the bold/underlined line? The error is runtime error -Application defined or object undefined.


Sub populateSheets()


Set empSheet = Sheets("Employee Sheet")

lr = empSheet.Range("A" & Rows.Count).End(x1Up).Row

For Each c In empSheet.Range("A1:A" & lr)

If wsExists(c.Text) Then
empSheet.Range("A" & c.Row & ":CT" & c.Row).Copy
Sheets(c.Text).Range("G1").PasteSpecial Transpose:=True
Else
MsgBox "Worksheet " & c.Text & " not found"
End If

Next

End Sub

Function wsExists(ByVal sName As String) As Boolean

wsExists = False
For Each ws In Worksheets
If sName = ws.Name Then
Exit Function
End If
Next ws

End Function

 

[sericom]

x1Up should be xlUp