Copy and Paste issue between worksheets

[mikenelena]

So I am looking to copy 4 columns of data (C,D,G,H) from a worksheet called "Main" to target worksheets. columns A,B,E, and F. The code is copying C and D to A and B. Column D is pasting to D, and G and H are not pasting at all.I believe the issues lies in this block of code, but I'm not sure what the exact problem is. (If it matters, column C is a file number, B is date, G is currency, and H is a comment.) As always, I appreciate any help folks can ofer.

If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
                Dim copyRange As Range
                Set copyRange = Union(appraiserNamesRange.Cells(i, 3).Resize(1, 2), appraiserNamesRange.Cells(i, 7).Resize(1, 2))
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 2).Resize(1, 2).Value
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 3).Resize(1, 2).Value = copyRange.Value
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
            End If

Here is the full code:

Sub CopyDataToWorksheets()

Dim mainSheet As Worksheet
Dim generalsSheet As Worksheet
Dim payrollDatesRange As Range
Dim lastPayrollDate As Date
Dim appraiserNamesRange As Range
Dim appraiserName As String
Dim destinationSheetName As String
Dim destinationSheet As Worksheet
Dim i As Long

' Set references to the relevant worksheets
Set mainSheet = ThisWorkbook.Worksheets("Main")
Set generalsSheet = ThisWorkbook.Worksheets("Generals")

Application.ScreenUpdating = False

' Determine the most recent payroll date
Set payrollDatesRange = mainSheet.Range("B:B")
lastPayrollDate = WorksheetFunction.Max(payrollDatesRange)

' Set the appraiser names range to only include the rows with the most recent payroll date
Set appraiserNamesRange = mainSheet.Range("A:C").Find(What:=lastPayrollDate, LookIn:=xlValues, LookAt:=xlWhole)

    If Not appraiserNamesRange Is Nothing Then
        Set appraiserNamesRange = appraiserNamesRange.Resize(mainSheet.Range("A:C").End(xlDown).Row - appraiserNamesRange.Row + 1, 3)
    
        ' Loop through the appraiser names range and copy/paste the data to the appropriate worksheets
        For i = 1 To appraiserNamesRange.Rows.Count
            appraiserName = appraiserNamesRange.Cells(i, 0).Value
            destinationSheetName = Application.VLookup(appraiserName, generalsSheet.Range("A:H"), 8, False)
            
            If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
                Dim copyRange As Range
                Set copyRange = Union(appraiserNamesRange.Cells(i, 3).Resize(1, 2), appraiserNamesRange.Cells(i, 7).Resize(1, 2))
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 2).Resize(1, 2).Value
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 3).Resize(1, 2).Value = copyRange.Value
                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
            End If

        Next i
    
    Else
        
        MsgBox "No data found for the most recent payroll date."
            
    End If

Application.ScreenUpdating = True
    
' Clear clipboard and display a message
Application.CutCopyMode = False

MsgBox "Data has been copied to the appropriate worksheets."

End Sub

 

[aRandomHelper]

Try this:

            If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
'                Dim copyRange As Range
'                Set copyRange = Union(appraiserNamesRange.Cells(i, 3).Resize(1, 2), appraiserNamesRange.Cells(i, 7).Resize(1, 2))
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 2).Resize(1, 2).Value
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 3).Resize(1, 2).Value = copyRange.Value
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
                With destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1)
                    .Resize(1, 2).Value = appraiserNamesRange.Cells(i, 3).Resize(1, 2).Value
                    .Offset(0, 4).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 7).Resize(1, 2).Value
                    .Offset(0, 1).NumberFormat = "mm-dd-yyyy"
                End With
            End If

 

[HaHoBe]

Hi mikenelena

maybe like this

        For i = 1 To appraiserNamesRange.Rows.Count
            appraiserName = appraiserNamesRange.Cells(i, 0).Value
            destinationSheetName = Application.VLookup(appraiserName, generalsSheet.Range("A:H"), 8, False)
            
            If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
                Dim copyRange As Range
                Dim lngFirstFree As Long
                lngFirstFree = destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Row + 1
                Set copyRange = Range(appraiserNamesRange.Row, "C").Resize(1, 2)
                destinationSheet.Cells(lngFirstFree, "A").Resize(1, 2).Value = copyRange.Value
                Set copyRange = Range(appraiserNamesRange.Row, "G").Resize(1, 2)
                destinationSheet.Cells(lngFirstFree, "E").Resize(1, 2).Value = copyRange.Value
                destinationSheet.Cells(lngFirstFree, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
            End If

        Next i

I wonder why you look for the max in Column B and search in Columns A to C for that value.

Holger

 

[mikenelena]

Try this:

            If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
'                Dim copyRange As Range
'                Set copyRange = Union(appraiserNamesRange.Cells(i, 3).Resize(1, 2), appraiserNamesRange.Cells(i, 7).Resize(1, 2))
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 2).Resize(1, 2).Value
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 3).Resize(1, 2).Value = copyRange.Value
'                destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
                With destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Offset(1)
                    .Resize(1, 2).Value = appraiserNamesRange.Cells(i, 3).Resize(1, 2).Value
                    .Offset(0, 4).Resize(1, 2).Value = appraiserNamesRange.Cells(i, 7).Resize(1, 2).Value
                    .Offset(0, 1).NumberFormat = "mm-dd-yyyy"
                End With
            End If

I appreciate it aRandomHelper, but this produces a subscript out of range error on the following line:

Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)

 

[mikenelena]

Hi mikenelena

maybe like this

        For i = 1 To appraiserNamesRange.Rows.Count
            appraiserName = appraiserNamesRange.Cells(i, 0).Value
            destinationSheetName = Application.VLookup(appraiserName, generalsSheet.Range("A:H"), 8, False)
           
            If Not IsError(destinationSheetName) Then
                Set destinationSheet = ThisWorkbook.Worksheets(destinationSheetName)
                Dim copyRange As Range
                Dim lngFirstFree As Long
                lngFirstFree = destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Row + 1
                Set copyRange = Range(appraiserNamesRange.Row, "C").Resize(1, 2)
                destinationSheet.Cells(lngFirstFree, "A").Resize(1, 2).Value = copyRange.Value
                Set copyRange = Range(appraiserNamesRange.Row, "G").Resize(1, 2)
                destinationSheet.Cells(lngFirstFree, "E").Resize(1, 2).Value = copyRange.Value
                destinationSheet.Cells(lngFirstFree, 1).End(xlUp).Offset(0, 1).NumberFormat = "mm-dd-yyyy"
            End If

        Next i

I wonder why you look for the max in Column B and search in Columns A to C for that value.

Holger

I appreciate the helo HaHoBe, but this caused a subscript out of range error on the line:

Set copyRange = Range(appraiserNamesRange.Row, "C").Resize(1, 2)

As to this question:

I wonder why you look for the max in Column B and search in Columns A to C for that value.

That not really what I intended. Column B is sorted. I want to examine it for a maximum date and work only with rows with that maximum date. (There will be many repeating maximum date values.) To determine the target worksheet for a given row, I need to take the value from column A (which will contain an employee name) and use that to obtain the target sheet name from Column H of a worksheet called "Generals". I've done that with the Vlookup. There is probably a better way, but I would like to solve the main issue first if I can.

 

[HaHoBe]

,

mixing Range and Cells is never a good idea, use either

                'first range
                Set copyRange = Range("C" & appraiserNamesRange.Row).Resize(1, 2)
                'or
                Set copyRange = Cells(appraiserNamesRange.Row, "C").Resize(1, 2)

                'second range
                Set copyRange = Range("G" & appraiserNamesRange.Row).Resize(1, 2)
                'or
                Set copyRange = Cells(appraiserNamesRange.Row, "G").Resize(1, 2)

Holger

 

[mikenelena]

Hi HaHoBe,

The 2nd effort got it to work. I much appreciate your help! I went with the copyRange, by the way. My understanding is that it is the faster of the 2 ways.

 

[mikenelena]

,

mixing Range and Cells is never a good idea, use either

                'first range
                Set copyRange = Range("C" & appraiserNamesRange.Row).Resize(1, 2)
                'or
                Set copyRange = Cells(appraiserNamesRange.Row, "C").Resize(1, 2)

                'second range
                Set copyRange = Range("G" & appraiserNamesRange.Row).Resize(1, 2)
                'or
                Set copyRange = Cells(appraiserNamesRange.Row, "G").Resize(1, 2)

Holger

HaHoBe,

I responded too quickly. I was so focused on making sure data came into all columns that I didn't notice that all data is the same. The code should be iterating through the names in Column A and distributing the rows with their 4 relevant columns of data (C,D,G,H) to target worksheets columns A,B,E, and F. Right now, the code is taking the values for the first row and distributing those same values for each name in the list. So, the number of rows moved is correct, but the values are wrong. Could I trouble you to take one more look for me? Thank you!!

 

[mikenelena]

HaHoBe,

I responded too quickly. I was so focused on making sure data came into all columns that I didn't notice that all data is the same. The code should be iterating through the names in Column A and distributing the rows with their 4 relevant columns of data (C,D,G,H) to target worksheets columns A,B,E, and F. Right now, the code is taking the values for the first row and distributing those same values for each name in the list. So, the number of rows moved is correct, but the values are wrong. Could I trouble you to take one more look for me? Thank you!!

**Edit** I found the error:

This:

Set copyRange = mainSheet.Range("C" & appraiserNamesRange.Row + i - 1).Resize(1, 2)

Instead of this:

'Set copyRange = Range("C" & appraiserNamesRange.Row).Resize(1, 2)

and this:

Set copyRange = mainSheet.Range("G" & appraiserNamesRange.Row + i - 1).Resize(1, 2)

Instead of this:

'Set copyRange = Range("G" & appraiserNamesRange.Row).Resize(1, 2)

Many thanks again!