Forum Discussion

TeachASU2020's avatar
TeachASU2020
Copper Contributor
Jun 29, 2022

Copy and paste with vba

I have a worksheet that I import several times a day.  It lists employees and orders pulled..  What I need to have happen is For each employee (Emp1) it will copy the row and paste it to another work...
Macros and VBA
OliverScheurich's avatar
OliverScheurich
Gold Contributor
Jun 30, 2022

TeachASU2020 

Sub DiscrepFormReport()


Dim Emp1 As Worksheet
Dim Emp2 As Worksheet
Dim Emp3 As Worksheet
Dim Emp4 As Worksheet
Dim i As Long

Set Emp1 = Worksheets("Emp1")
Set Emp2 = Worksheets("Emp2")
Set Emp3 = Worksheets("Emp3")
Set Emp4 = Worksheets("Emp4")


Application.ScreenUpdating = False

For i = 2 To 200

If Cells(i, 2).Value = "Emp1" Then


Worksheets("RawData").Range(Cells(i, 3), Cells(i, 6)).Copy
Emp1.Select
Emp1.Range(Cells(i, 3), Cells(i, 6)).PasteSpecial Paste:=xlPasteValues
Worksheets("RawData").Select

Else

    If Cells(i, 2).Value = "Emp2" Then
    
    
    Worksheets("RawData").Range(Cells(i, 3), Cells(i, 6)).Copy
    Emp2.Select
    Emp2.Range(Cells(i, 3), Cells(i, 6)).PasteSpecial Paste:=xlPasteValues
    Worksheets("RawData").Select
    
    Else
            If Cells(i, 2).Value = "Emp3" Then
            
            
            Worksheets("RawData").Range(Cells(i, 3), Cells(i, 6)).Copy
            Emp3.Select
            Emp3.Range(Cells(i, 3), Cells(i, 6)).PasteSpecial Paste:=xlPasteValues
            Worksheets("RawData").Select
            
            Else
            
                    If Cells(i, 2).Value = "Emp4" Then
                    
                    
                    Worksheets("RawData").Range(Cells(i, 3), Cells(i, 6)).Copy
                    Emp4.Select
                    Emp4.Range(Cells(i, 3), Cells(i, 6)).PasteSpecial Paste:=xlPasteValues
                    Worksheets("RawData").Select
                    
                    Else
                    
                    
                    End If
            
            End If
    
    End If

End If

Next i

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

Maybe with this code. In the attached file you can click the button in cell H2 to start the macro.

 

Resources