scheckkr
11-23-2015, 08:24 AM
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
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