Can anybody help please.
I have a workbook with a worksheet called “Cert Data” on this sheet in column A I have a list of cert numbers, in column N on the same sheet I have a list of cert registers
The cert registers are in number order
Material Receipt & Traceability Register 01 Pipe
Material Receipt & Traceability Register 02 Section
Etc.
The cert numbers are also in number order, and all 01’s are in the 01 register 02’s in the 02 register ect.
01-1234
01-1235
02-1234 Etc
In column A sheet1 of the cert registers are the cert numbers, what I am trying to do is open up each register one at a time find the cert numbers from my list, then copy the information from columns B through to J and paste adjacent to the matching cert numbers in my list on the the "cert data" sheet. Then close that register and open the next one, then repeat.
The registers are opening fine (thanks to help from this board), but my code where it is meant to copy does not work it just skips past it, and opens the next workbook.
any help is always appreciated Code below
I have a workbook with a worksheet called “Cert Data” on this sheet in column A I have a list of cert numbers, in column N on the same sheet I have a list of cert registers
The cert registers are in number order
Material Receipt & Traceability Register 01 Pipe
Material Receipt & Traceability Register 02 Section
Etc.
The cert numbers are also in number order, and all 01’s are in the 01 register 02’s in the 02 register ect.
01-1234
01-1235
02-1234 Etc
In column A sheet1 of the cert registers are the cert numbers, what I am trying to do is open up each register one at a time find the cert numbers from my list, then copy the information from columns B through to J and paste adjacent to the matching cert numbers in my list on the the "cert data" sheet. Then close that register and open the next one, then repeat.
The registers are opening fine (thanks to help from this board), but my code where it is meant to copy does not work it just skips past it, and opens the next workbook.
any help is always appreciated Code below
VBA Code:
Sub CopyFromAllRegisters()
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Dim i As Integer
Dim c As Integer
Dim directory As String
Dim filename As String
Dim ws As Worksheet
Dim wb As Workbook
Dim wbk As Workbook
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Worksheets("Cert Data")
'define location of material registers
directory = "L:\MATERIALS\Material Certification\"
'-----------------------------------------------------------------code to open each material register in turn
For i = 2 To Cells(Rows.Count, "N").End(xlUp).Row 'N is the column name where the filenames are stored
'define filename of material registers
filename = Dir(directory & ws.Range("N" & i).Value & ".xlsm")
If filename <> "" Then 'check if material register does not exist
Set wbk = Workbooks.Open(directory & filename, ReadOnly:=True) 'open material register
'-----------------------------------------------------------------Need to add my code here
wb.Activate
Worksheets("Cert Data").Select
Range("A1").Select
Range("A1", Range("A1").End(xlDown)).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes 'sorting the numbers in order to match the order the excel material registers
For c = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'counting the cert numbers we need to search for
a = ws.Cells(c, 1).Value
wbk.Activate
For J = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If Worksheets(1).Cells(J, 1).Value = a Then 'If cert number (Row 1) in column A on the first sheet on the Material registers
' '= the cert number(Value a)in column 1 in worksheet "Cert Data" in the active workbook
'then copy cells 2 thru to 10, from the Material register to the Cert Data sheet on active workbook
'then continue seach every row to look for more matches
'then repeat on each workbook as it is opened.
Worksheets(1).Cells(J, 2).Value = ws.Cells(i, 2).Value 'copying from the first sheet of the material register, after finding the cert number. to matching cert number on "cert data" sheet
Worksheets(1).Cells(J, 3).Value = ws.Cells(i, 3).Value
Worksheets(1).Cells(J, 4).Value = ws.Cells(i, 4).Value
Worksheets(1).Cells(J, 5).Value = ws.Cells(i, 5).Value
Worksheets(1).Cells(J, 6).Value = ws.Cells(i, 6).Value
Worksheets(1).Cells(J, 7).Value = ws.Cells(i, 7).Value
Worksheets(1).Cells(J, 8).Value = ws.Cells(i, 8).Value
Worksheets(1).Cells(J, 9).Value = ws.Cells(i, 9).Value
Worksheets(1).Cells(J, 10).Value = ws.Cells(i, 10).Value
End If
Next J
Next c
''-----------------------------------------------------------------to here
End If
wbk.Close (False)
Next i 'loop ends here and it will continue to last material register as it works down the list
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
