Copy and paste columns between sheets based on an Excel "Map" or table? - Further autoexecute file links? - excel

Question

I have been doing this manually for far too long, and I feel there must be a way to speed up this process. Hopefully you guys can help me.
Currently I have an excel file that has written in VBA macros that copy and paste certain columns from one sheet and paste them into another sheet. There are about 160 of these written, each with about 10 copy/paste commands. (This workbook is called workbook A)
Currently my method involves me opening up Workbook B, copying the data into a sheet in Workbook A, selecting a macro to run from a dropdown in Workbook A, copying the results and pasting them into a "master" Workbook C. The problem for me is that There are frequent instances when maps - that is the column locations of data - change in Workbook B. I maintain a "master map" file that looks something like this:
Contract# | Purchaser | Price | Quantity | Total
------------------------------------------------
A | B | C | D | E
------------------------------------------------
G | D | C | A | B
------------------------------------------------
etc. (Apologies if that's messy)
What I would like to do is have the sheet do the copying and pasting automatically based on A: The column on the map (the pasting column) and B: the letter represented in the row for that particular Contract (this copies the column of which the letter represented).
Is this possible?
Secondly, if that is - The option to have this execute automatically by specifying the file patch of each file would be outstanding (I have a clear taxonomy of file locations and names). Is that also possible?
Added condensed sample of ran macro.
The macro is quite simple, here is a sample...
Sub PA979()
Application.ScreenUpdating = False
'Retail $
Sheets("VSR Input").Select
Range("x1:x5004").Copy
Sheets("Sheet1").Select
Range("q4").Select
ActiveSheet.Paste
'PA $
Sheets("VSR Input").Select
Range("y1:y5004").Copy
Sheets("Sheet1").Select
Range("s4").Select
ActiveSheet.Paste
'Q
Sheets("VSR Input").Select
Range("z1:z5004").Copy
Sheets("Sheet1").Select
Range("t4").Select
ActiveSheet.Paste
'Total $
Sheets("VSR Input").Select
Range("aa1:aa5004").Copy
Sheets("Sheet1").Select
Range("u4").Select
ActiveSheet.Paste
Range("A1").Select
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim usedRows As Long
usedRows = ws.Cells(ws.Rows.Count, "U").End(xlUp).Row
Application.ScreenUpdating = False
Sheets("Sheet1").Select
Range("v3").Select
ActiveCell.FormulaR1C1 = "PA#"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = "979"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range(Cells(1, 1), Cells(usedRows - 3, 1)), Type:= _
xlFillDefault
Range("v4").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
End Sub `

Answer 1

Assumes the workbook containing the macro has a worksheet "map" with one row for each contract number:
A: contract number
B: file path for the input workbook
C-F: source column letters for each of the columns being copied
Row 2 on the Map sheet has the destination column letters in cols C-F
Compiled but not tested:
Option Explicit
Sub Tester()
CopyData 979
End Sub
Sub CopyData(contractNumber)
Dim wbInput As Workbook
Dim wbDest As Workbook
Dim shtIn As Worksheet, shtDest As Worksheet, shtMap As Worksheet
Dim usedRows As Long
Dim arrDestCols, x As Integer, cFrom, cTo
Dim f As Range, mapRow As Range
'has the column mapping info for each contract number
Set shtMap = ThisWorkbook.Sheets("Map")
'find the row for this contract number
Set f = shtMap.Range("A3:A100").Find(contractNumber, , xlValues, xlWhole)
If f Is Nothing Then
MsgBox "contract number " & contractNumber & " not found!"
Exit Sub
Else
Set mapRow = f.EntireRow
End If
'assumes input file path is in column B
Set wbInput = Workbooks.Open(mapRow.Cells(2).Value)
Set shtIn = wbInput.Sheets("VSR Input")
Set wbDest = ThisWorkbook
Set shtDest = wbDest.Sheets("Sheet1")
Application.ScreenUpdating = False
For x = 1 To 4
' "source" column letters are in columns C-F of the found row
cFrom = mapRow.Cells(2 + x).Value
' "destination" column letters are in C2:F2 of the Map sheet
cTo = shtMap.Rows(2).Cells(2 + x).Value
shtIn.Range(cFrom & "1").Resize(5004, 1).Copy shtDest.Range(cTo & "4")
Next x
With shtDest
usedRows = .Cells(.Rows.Count, "U").End(xlUp).Row
.Range("v3").Value = contractNumber
.Range("v4").Resize(usedRows - 3, 1).Value = contractNumber
End With
wbInput.Close False
End Sub