RedAxon
12-15-2016, 03:36 AM
Greetings,
I have the below code working as intended, however the amount of items I need to apply this code to has increased from a handful to several hundred. So I would like to apply a loop to the following code so that it goes through every excel document in the folder and performs the task:
Sub InspectionSheetTransfer()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim vFile As Variant
'Set source workbook
Set wbSource = ActiveWorkbook
'Open the source workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wbTarget = ActiveWorkbook
'transfer values
'Tag Number
wbSource.Sheets("Sheet1").Range("A2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
'Location
wbSource.Sheets("Sheet1").Range("C2").Value = wbTarget.Sheets("Insp. Sheet").Range("T8")
'Equipment Description
wbSource.Sheets("Sheet1").Range("E2").Value = wbTarget.Sheets("Insp. Sheet").Range("C10")
'Manufacturer
wbSource.Sheets("Sheet1").Range("J2").Value = wbTarget.Sheets("Insp. Sheet").Range("I10")
'Model
wbSource.Sheets("Sheet1").Range("K2").Value = wbTarget.Sheets("Insp. Sheet").Range("P10")
'Serial Number
wbSource.Sheets("Sheet1").Range("L2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
'Cable Reference
wbSource.Sheets("Sheet1").Range("M2").Value = wbTarget.Sheets("Insp. Sheet").Range("C12")
'Ex Protection
wbSource.Sheets("Sheet1").Range("O2").Value = wbTarget.Sheets("Insp. Sheet").Range("H12")
'Gas Group
wbSource.Sheets("Sheet1").Range("P2").Value = wbTarget.Sheets("Insp. Sheet").Range("L12")
'T Rating
wbSource.Sheets("Sheet1").Range("Q2").Value = wbTarget.Sheets("Insp. Sheet").Range("O12")
'IP Rating
wbSource.Sheets("Sheet1").Range("R2").Value = wbTarget.Sheets("Insp. Sheet").Range("R12")
'Cert Number
wbSource.Sheets("Sheet1").Range("S2").Value = wbTarget.Sheets("Insp. Sheet").Range("U12")
'Drawing Number
wbSource.Sheets("Sheet1").Range("T2").Value = wbTarget.Sheets("Insp. Sheet").Range("C14")
'Grid Ref
wbSource.Sheets("Sheet1").Range("U2").Value = wbTarget.Sheets("Insp. Sheet").Range("I14")
'Area Class
wbSource.Sheets("Sheet1").Range("W2").Value = wbTarget.Sheets("Insp. Sheet").Range("L14")
'Cert Auth
wbSource.Sheets("Sheet1").Range("X2").Value = wbTarget.Sheets("Insp. Sheet").Range("O14")
'Access Normal
wbSource.Sheets("Sheet1").Range("AE2").Value = wbTarget.Sheets("Insp. Sheet").Range("I15")
'Access Ladder
wbSource.Sheets("Sheet1").Range("AF2").Value = wbTarget.Sheets("Insp. Sheet").Range("M15")
'Access Scaffold
wbSource.Sheets("Sheet1").Range("AG2").Value = wbTarget.Sheets("Insp. Sheet").Range("Q15")
'Access Ropes
wbSource.Sheets("Sheet1").Range("AH2").Value = wbTarget.Sheets("Insp. Sheet").Range("U15")
'Access Overside
wbSource.Sheets("Sheet1").Range("AI2").Value = wbTarget.Sheets("Insp. Sheet").Range("Y15")
'Area Class 0
wbSource.Sheets("Sheet1").Range("AK2").Value = wbTarget.Sheets("Insp. Sheet").Range("F17")
'Area Class 1
wbSource.Sheets("Sheet1").Range("AL2").Value = wbTarget.Sheets("Insp. Sheet").Range("F18")
'Area Class 2
wbSource.Sheets("Sheet1").Range("AM2").Value = wbTarget.Sheets("Insp. Sheet").Range("F19")
'Area Class Safe
wbSource.Sheets("Sheet1").Range("AN2").Value = wbTarget.Sheets("Insp. Sheet").Range("F20")
'Ignition Risk H
wbSource.Sheets("Sheet1").Range("AP2").Value = wbTarget.Sheets("Insp. Sheet").Range("J17")
'Ignition Risk m
wbSource.Sheets("Sheet1").Range("AQ2").Value = wbTarget.Sheets("Insp. Sheet").Range("J18")
'Ignition Risk L
wbSource.Sheets("Sheet1").Range("AR2").Value = wbTarget.Sheets("Insp. Sheet").Range("J19")
'Enviroment S
wbSource.Sheets("Sheet1").Range("AT2").Value = wbTarget.Sheets("Insp. Sheet").Range("N17")
'Enviroment m
wbSource.Sheets("Sheet1").Range("AU2").Value = wbTarget.Sheets("Insp. Sheet").Range("N18")
'Enviroment b
wbSource.Sheets("Sheet1").Range("AV2").Value = wbTarget.Sheets("Insp. Sheet").Range("N19")
'corrosion h
wbSource.Sheets("Sheet1").Range("AX2").Value = wbTarget.Sheets("Insp. Sheet").Range("R17")
'corrosion m
wbSource.Sheets("Sheet1").Range("AY2").Value = wbTarget.Sheets("Insp. Sheet").Range("R18")
'corrosion l
wbSource.Sheets("Sheet1").Range("AZ2").Value = wbTarget.Sheets("Insp. Sheet").Range("R19")
'vibration h
wbSource.Sheets("Sheet1").Range("BB2").Value = wbTarget.Sheets("Insp. Sheet").Range("V17")
'vibration m
wbSource.Sheets("Sheet1").Range("BC2").Value = wbTarget.Sheets("Insp. Sheet").Range("V18")
'vibration l
wbSource.Sheets("Sheet1").Range("BD2").Value = wbTarget.Sheets("Insp. Sheet").Range("V19")
'inspection date
wbSource.Sheets("Sheet1").Range("BF2").Value = wbTarget.Sheets("Insp. Sheet").Range("L151")
'grade of inspection
wbSource.Sheets("Sheet1").Range("BG2").Value = wbTarget.Sheets("Insp. Sheet").Range("W24")
'inspected by
wbSource.Sheets("Sheet1").Range("BJ2").Value = wbTarget.Sheets("Insp. Sheet").Range("L154")
'close inspection sheet
wbTarget.Close
End Sub
In addition to applying the loop, the ability for the macro to enter a new line above once finished would be essentially (i.e, move the just completed line down 1)
Thank you very much for taking the time to read this, I look forward to your reply.
I have the below code working as intended, however the amount of items I need to apply this code to has increased from a handful to several hundred. So I would like to apply a loop to the following code so that it goes through every excel document in the folder and performs the task:
Sub InspectionSheetTransfer()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim vFile As Variant
'Set source workbook
Set wbSource = ActiveWorkbook
'Open the source workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wbTarget = ActiveWorkbook
'transfer values
'Tag Number
wbSource.Sheets("Sheet1").Range("A2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
'Location
wbSource.Sheets("Sheet1").Range("C2").Value = wbTarget.Sheets("Insp. Sheet").Range("T8")
'Equipment Description
wbSource.Sheets("Sheet1").Range("E2").Value = wbTarget.Sheets("Insp. Sheet").Range("C10")
'Manufacturer
wbSource.Sheets("Sheet1").Range("J2").Value = wbTarget.Sheets("Insp. Sheet").Range("I10")
'Model
wbSource.Sheets("Sheet1").Range("K2").Value = wbTarget.Sheets("Insp. Sheet").Range("P10")
'Serial Number
wbSource.Sheets("Sheet1").Range("L2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
'Cable Reference
wbSource.Sheets("Sheet1").Range("M2").Value = wbTarget.Sheets("Insp. Sheet").Range("C12")
'Ex Protection
wbSource.Sheets("Sheet1").Range("O2").Value = wbTarget.Sheets("Insp. Sheet").Range("H12")
'Gas Group
wbSource.Sheets("Sheet1").Range("P2").Value = wbTarget.Sheets("Insp. Sheet").Range("L12")
'T Rating
wbSource.Sheets("Sheet1").Range("Q2").Value = wbTarget.Sheets("Insp. Sheet").Range("O12")
'IP Rating
wbSource.Sheets("Sheet1").Range("R2").Value = wbTarget.Sheets("Insp. Sheet").Range("R12")
'Cert Number
wbSource.Sheets("Sheet1").Range("S2").Value = wbTarget.Sheets("Insp. Sheet").Range("U12")
'Drawing Number
wbSource.Sheets("Sheet1").Range("T2").Value = wbTarget.Sheets("Insp. Sheet").Range("C14")
'Grid Ref
wbSource.Sheets("Sheet1").Range("U2").Value = wbTarget.Sheets("Insp. Sheet").Range("I14")
'Area Class
wbSource.Sheets("Sheet1").Range("W2").Value = wbTarget.Sheets("Insp. Sheet").Range("L14")
'Cert Auth
wbSource.Sheets("Sheet1").Range("X2").Value = wbTarget.Sheets("Insp. Sheet").Range("O14")
'Access Normal
wbSource.Sheets("Sheet1").Range("AE2").Value = wbTarget.Sheets("Insp. Sheet").Range("I15")
'Access Ladder
wbSource.Sheets("Sheet1").Range("AF2").Value = wbTarget.Sheets("Insp. Sheet").Range("M15")
'Access Scaffold
wbSource.Sheets("Sheet1").Range("AG2").Value = wbTarget.Sheets("Insp. Sheet").Range("Q15")
'Access Ropes
wbSource.Sheets("Sheet1").Range("AH2").Value = wbTarget.Sheets("Insp. Sheet").Range("U15")
'Access Overside
wbSource.Sheets("Sheet1").Range("AI2").Value = wbTarget.Sheets("Insp. Sheet").Range("Y15")
'Area Class 0
wbSource.Sheets("Sheet1").Range("AK2").Value = wbTarget.Sheets("Insp. Sheet").Range("F17")
'Area Class 1
wbSource.Sheets("Sheet1").Range("AL2").Value = wbTarget.Sheets("Insp. Sheet").Range("F18")
'Area Class 2
wbSource.Sheets("Sheet1").Range("AM2").Value = wbTarget.Sheets("Insp. Sheet").Range("F19")
'Area Class Safe
wbSource.Sheets("Sheet1").Range("AN2").Value = wbTarget.Sheets("Insp. Sheet").Range("F20")
'Ignition Risk H
wbSource.Sheets("Sheet1").Range("AP2").Value = wbTarget.Sheets("Insp. Sheet").Range("J17")
'Ignition Risk m
wbSource.Sheets("Sheet1").Range("AQ2").Value = wbTarget.Sheets("Insp. Sheet").Range("J18")
'Ignition Risk L
wbSource.Sheets("Sheet1").Range("AR2").Value = wbTarget.Sheets("Insp. Sheet").Range("J19")
'Enviroment S
wbSource.Sheets("Sheet1").Range("AT2").Value = wbTarget.Sheets("Insp. Sheet").Range("N17")
'Enviroment m
wbSource.Sheets("Sheet1").Range("AU2").Value = wbTarget.Sheets("Insp. Sheet").Range("N18")
'Enviroment b
wbSource.Sheets("Sheet1").Range("AV2").Value = wbTarget.Sheets("Insp. Sheet").Range("N19")
'corrosion h
wbSource.Sheets("Sheet1").Range("AX2").Value = wbTarget.Sheets("Insp. Sheet").Range("R17")
'corrosion m
wbSource.Sheets("Sheet1").Range("AY2").Value = wbTarget.Sheets("Insp. Sheet").Range("R18")
'corrosion l
wbSource.Sheets("Sheet1").Range("AZ2").Value = wbTarget.Sheets("Insp. Sheet").Range("R19")
'vibration h
wbSource.Sheets("Sheet1").Range("BB2").Value = wbTarget.Sheets("Insp. Sheet").Range("V17")
'vibration m
wbSource.Sheets("Sheet1").Range("BC2").Value = wbTarget.Sheets("Insp. Sheet").Range("V18")
'vibration l
wbSource.Sheets("Sheet1").Range("BD2").Value = wbTarget.Sheets("Insp. Sheet").Range("V19")
'inspection date
wbSource.Sheets("Sheet1").Range("BF2").Value = wbTarget.Sheets("Insp. Sheet").Range("L151")
'grade of inspection
wbSource.Sheets("Sheet1").Range("BG2").Value = wbTarget.Sheets("Insp. Sheet").Range("W24")
'inspected by
wbSource.Sheets("Sheet1").Range("BJ2").Value = wbTarget.Sheets("Insp. Sheet").Range("L154")
'close inspection sheet
wbTarget.Close
End Sub
In addition to applying the loop, the ability for the macro to enter a new line above once finished would be essentially (i.e, move the just completed line down 1)
Thank you very much for taking the time to read this, I look forward to your reply.