Copy/Paste Function not working properly in Loop

[scheckkr]

The code below is being used to automatically transfer data from one workbook to another based on a job number and a sequence number matching. The problem that I am running into is that multiple jobs have the same sequence number and it is copying the same data into each job. For example:

Worksheet #1 of Workbook #2
Job #1, Seq. #1

Worksheet #2 of Workbook #2
Job #2, Seq. #1

The information for Job #1, Seq. #1 is being transferred over to the destination workbook in both of the above cases.


Sub Copy_Data_From_Update_To_Master()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomaticcode tags added

Dim wbSource As Workbook
Dim wsDestination As Worksheet

Dim i As Long, j As Long, k As Long
Dim rngDesJob As Range, rngDesSeq As Range, rngSrcSeq As Range
Dim ws As Worksheet
Dim strSrcJob As String

Set wbSource = Workbooks.Open("Source File")
Set wsDestination = ThisWorkbook.Worksheets("SCHEDULE")

For Each ws In wbSource.Worksheets
strSrcJob = ws.Range("M8").Value

For i = 5 To wsDestination.Range("A" & Rows.Count).End(xlUp).Row
Set rngDesJob = wsDestination.Range("A" & i)

If strSrcJob = rngDesJob Then
For j = 5 To wsDestination.Range("B" & Rows.Count).End(xlUp).Row
Set rngDesSeq = wsDestination.Range("B" & j)
For k = 11 To ws.Range("A" & Rows.Count).End(xlUp).Row
Set rngSrcSeq = ws.Range("A" & k)

If rngDesSeq = rngSrcSeq Then
wbSource.Activate
ws.Range(ws.Cells(k, 3), ws.Cells(k, 14)).Copy
wsDestination.Activate
wsDestination.Range(Cells(j, 11), Cells(j, 22)).PasteSpecial Paste:=xlPasteValues
End If
Next k
Next j
End If
Next i
Next ws

wbSource.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[mancubus]

welcome to the board.

you can post your code by hitting # button after pasting and selecting the code.

post your workbook:
Go Advanced, Manage Attachments, Add Files, Select Files, (select the file/s and click Open), Upload Files, Done
before posting it alter sensitive/confidential data.

in the workbook, care to provide an example of the desired output.

[SamT]

I inverted the two outer loops. I don't think this will work anyway. The underlying premise is that Sequence numbers on Job Sheets are unique. If there is the same Sequence number on two or more Job sheets, only the last job sheet's data will be present on the Destination Sheet, all the previous will be copied over.

If this is an issue, we ill have to see a sample of the two workbooks to solve it.


Option Explicit

Sub Copy_Data_From_Update_To_Master()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim DesSht As Worksheet
Dim SrcBk As Workbook
Dim SrcSht As Worksheet

Dim i As Long, j As Long, k As Long

Set DesSht = ThisWorkbook.Worksheets("SCHEDULE")
Set SrcBk = Workbooks.Open("Source File")

For i = 5 To DesSht.Range("A" & Rows.Count).End(xlUp).Row
For Each SrcSht In SrcBk.Worksheets
'Check Job #
If SrcSht.Range("M8") = DesSht.Range("A" & i) Then
For j = 5 To DesSht.Range("B" & Rows.Count).End(xlUp).Row
'Check Seq #
For k = 11 To SrcSht.Range("A" & Rows.Count).End(xlUp).Row
If SrcSht.Range("A" & k) = DesSht.Range("B" & j) Then
SrcSht.Cells(k, 3).Resize(1, 12).Copy
DesSht.Cells(j, 11).PasteSpecial Paste:=xlPasteValues
End If
Next k
Next j
End If
Next SrcSht
Next i

SrcBk.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub