根据 Excel "Map"或表格在工作表之间复制和粘贴列？- 进一步自动执行文件链接？

Question

我手工做这个已经太久了，我觉得必须有一种方法来加快这个过程。希望你们能帮助我。

目前我有一个excel文件，已在VBA宏，复制和粘贴某些列从一个表和粘贴到另一个表中写入。大约有160个这样的脚本，每个脚本都有大约10个复制/粘贴命令。(这个工作簿叫做workbook A)

目前我的方法包括我打开Workbook B，将数据复制到Workbook A的表格中，选择一个宏从Workbook A的下拉菜单中运行，复制结果并将其粘贴到"主"Workbook C中。对我来说，问题是在Workbook B中，地图(即数据的列位置)经常发生变化。我维护了一个"主地图"文件，看起来像这样:

Contract# | Purchaser | Price | Quantity | Total
------------------------------------------------
A         |  B        |  C    |  D       |  E
------------------------------------------------
G         |  D        |  C    |  A       |  B
------------------------------------------------

等。(如果这是混乱的道歉)

我想做的是让工作表自动地根据A:地图上的列(粘贴列)和B:特定合同行中代表的字母(复制该字母代表的列)进行复制和粘贴。

这可能吗?

其次，如果是——通过指定每个文件的文件补丁来自动执行这个选项将是突出的(我有一个文件位置和名称的清晰分类)。这也有可能吗?

• 添加运行宏的压缩样本。

宏是相当简单的，这里是一个示例…

 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

假设包含宏的工作簿有一个工作表"map"，每个合同号对应一行:

A:合同号B:输入工作簿的文件路径C-F:要复制的每一列的源列字母

在地图工作表的第2行，目标列的字母以C-F的颜色表示

已编译但未测试:

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