How to copy paste information to another worksheet on exact rows-CodePudding

I need some help with my macros. The idea of this code is that I have one worksheet with big data about clients and multiple sheets which names are salesman's names. I want to copy and paste information about clients based on their salesman. In those salesman worksheet I have two places where I want to paste all clients: from 10th row in each worksheet I want to paste clients according to this condition If ws.Cells(i, "L").Value = salesmanName And ws.Cells(i, "I").Value = "valid". From 39 row in each worksheet I want to paste all clients with this condition ElseIf ws.Cells(i, "L").Value = salesmanName And Not ws.Cells(i, "I").Value = "valid" Then. Now with my code I get all clients of salesman from row 39 in each worksheet, maybe some of you will be able to help me to fix this problem.

Sub ExtractClientsBySalesman()
    ' Declare variables for the worksheet and last row of data
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim wsMatch As Worksheet

    ' Set the worksheet variable
    Set ws = ThisWorkbook.Sheets("data")
    

    ' Find the last row of data in the "data" worksheet
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    ' Loop through the data in column "D" (client)
    For i = 2 To lastRow
        ' Check if the value in column "salesman" (column "E") matches "name_surname"
        For Each wsMatch In ThisWorkbook.Sheets
            Dim pasteRow As Long
            Dim pasteRow2 As Long
            pasteRow = 10
            pasteRow2 = 39
            salesmanName = wsMatch.Range("A5").Value
            
            If ws.Cells(i, "L").Value = salesmanName And ws.Cells(i, "I").Value = "valid" Then
             ' Copy the client information to the new worksheet
                pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row   1
                ' Copy the client information to the worksheet
                wsMatch.Cells(pasteRow, 1).Value = ws.Cells(i, 1).Value
                wsMatch.Cells(pasteRow, 2).Value = ws.Cells(i, 9).Value
                wsMatch.Cells(pasteRow, 3).Value = ws.Cells(i, 42).Value
                wsMatch.Cells(pasteRow, 4).Value = ws.Cells(i, 4).Value
                wsMatch.Cells(pasteRow, 5).Value = ws.Cells(i, 14).Value
                wsMatch.Cells(pasteRow, 6).Value = ws.Cells(i, 16).Value
                wsMatch.Cells(pasteRow, 7).Value = ws.Cells(i, 40).Value
                wsMatch.Cells(pasteRow, 8).Value = ws.Cells(i, 12).Value
                
            ElseIf ws.Cells(i, "L").Value = salesmanName And Not ws.Cells(i, "I").Value = "valid" Then
                pasteRow2 = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row   1
                ' Copy the client information to the worksheet
                wsMatch.Cells(pasteRow2, 1).Value = ws.Cells(i, 1).Value
                wsMatch.Cells(pasteRow2, 2).Value = ws.Cells(i, 9).Value
                wsMatch.Cells(pasteRow2, 3).Value = ws.Cells(i, 42).Value
                wsMatch.Cells(pasteRow2, 4).Value = ws.Cells(i, 4).Value
                wsMatch.Cells(pasteRow2, 5).Value = ws.Cells(i, 14).Value
                wsMatch.Cells(pasteRow2, 6).Value = ws.Cells(i, 16).Value
                wsMatch.Cells(pasteRow2, 7).Value = ws.Cells(i, 40).Value
                wsMatch.Cells(pasteRow2, 8).Value = ws.Cells(i, 12).Value
                
            End If
        Next wsMatch
    Next i
End Sub

CodePudding user response：

Not tested because there is no data example, but my guess is that first time you got ws.Cells(i, "I").Value = "valid" it should go to row 10 and from now on row 11, 12 and so on.

Same for Not ws.Cells(i, "I").Value = "valid": first match should go to 39 and then later to 40, 41 and so on.

If cells A9 and A38 are headers row and they are not empty you could try this:

Replace pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row 1

with pasteRow = wsMatch.Range("A38").End(xlUp).Row 1

Your code does not work properly because if there is something in A38, when you do pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row 1 it will stop at row 38 and that would explain why you got everything into A39.

CodePudding user response：

1) It's better deal with next available line with different code. It's easier!
2) Also it's healthier that you exclude data worksheet from salesman worksheets.
3) It is advisable to use the Option Explicit clause to force to declare variables explicitly.

Option Explicit
Sub ExtractClientsBySalesman()
 ' Declare variables for the worksheet and last row of data
  Dim ws As Worksheet
  Dim lastRow As Long
  Dim wsMatch As Worksheet
  Dim valid As Boolean
  Dim lPaste As Long
  Dim i As Integer
  Dim salesmanName As String
  
' Initial line for each condition
  Dim pasteRow As Long
  Dim pasteRow2 As Long
  pasteRow = 10
  pasteRow2 = 39

' Set the worksheet variable
  Set ws = ThisWorkbook.Sheets("data")
        
' Find the last row of data in the "data" worksheet
  lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

 ' Loop through the data in column "D" (client)
   For i = 2 To lastRow
   ' column "salesman" (column "E") matches "name_surname"?
     For Each wsMatch In ThisWorkbook.Sheets
       If wsMatch.Name <> "data" Then
         salesmanName = wsMatch.Range("A5").Value
         lPaste = 0
         If ws.Cells(i, "L").Value = salesmanName Then
           valid = ws.Cells(i, "I").Value = "valid"
           If valid Then
            ' 1st section between lines 10 and 37. 
            ' Line 38 is 2nd section header
              lPaste = pasteRow2 - 2 
              ' 1st section after line 37 is invalid!
              If Not IsEmpty(wsMatch.Cells(lPaste, 1).Value) Then
                MsgBox ("Data overflow at first section")
                End ' Exit from program
              End If
              ' 1st available line between 10 and 37
              lPaste = wsMatch.Cells(lPaste, 1).End(xlUp).Row
              lPaste = Application.Max(pasteRow, lPaste   1)
           Else
              ' 1st available line after line 39
              lPaste = wsMatch.Cells(Cells.Rows.Count, 1).End(xlUp).Row
              lPaste = Application.Max(pasteRow2, lPaste   1)
           End If
         End If ' Same salesman

       ' Copy the client information to the new worksheet
         If (lPaste > 0) Then ' Same Salesman
           wsMatch.Cells(lPaste, 1).Value = ws.Cells(i, 1).Value
           wsMatch.Cells(lPaste, 2).Value = ws.Cells(i, 9).Value
           wsMatch.Cells(lPaste, 3).Value = ws.Cells(i, 42).Value
           wsMatch.Cells(lPaste, 4).Value = ws.Cells(i, 4).Value
           wsMatch.Cells(lPaste, 5).Value = ws.Cells(i, 14).Value
           wsMatch.Cells(lPaste, 6).Value = ws.Cells(i, 16).Value
           wsMatch.Cells(lPaste, 7).Value = ws.Cells(i, 40).Value
           wsMatch.Cells(lPaste, 8).Value = ws.Cells(i, 12).Value
         End If  ' Same Salesman
       End If  ' Other workshets than 'data'
     Next wsMatch
   Next i
End Sub