Question

我有一张4张的excel文件。这些纸张被命名为Sheet 1，Sheet 2，Sheet 3和Sheet 4。

每张工作表都有5列（产品，风险，类型，分部，名称），我想复制到新工作表（工作表5）。每张纸都有不同的结构，因此列不一样。我想将产品列中的所有数据复制到工作表5中的A列，将Risk列中的所有数据复制到工作表5中的B列，依此类推。最终结果将有5列（产品，风险，类型，部门，名称）。表1到表4中的数据行数都不同。

有人可以帮忙吗？我不能保密文件。感谢

Answer 1

曾经发生在我身上，不得不在一个单独的工作簿中将多个工作簿分别汇总到多个工作簿中。由于我无法查看代码或截图，因此我只能提出常见的事情 1.）如果所需列的名称以每个工作表的名称命名，则可以使用.find来确定列的编号并从那里绘制数据（从最后一行到第一行+ 1（因为第一行使用的行可能是标题））。

Set NeededColumn = ThisWorkbook.ws.Cells.Find(What:="ColumnName", _
    LookIn:=xlValues, LookAt:=xlPart, _
    after:=Cells(1, 1), MatchCase:=False, SearchFormat:=False)
ColumnNumber = NeededColumn.Column

其中ColumnName是新工作表中标题的名称。

我将使用更多有关此文件结构的详细信息更新建议更新答案。

Answer 2

你好运，那＆＃39;我曾经有过同样的问题。希望这可以帮到你。

'Datum:         20.07.17
'Autohr:        Moosli
'Definition:    main
'Parameter:     -
'
Option Explicit

Public Sub main()
    Dim wb As Workbook
    Dim wsDest As Worksheet
    Dim wsSour As Worksheet

    Dim i As Integer
    Dim j As Integer

    Dim intRowHeader As Integer
    Dim intColHeader As Integer
    Dim strSearch As String
    Dim lngLastRowDest As Long
    Dim lngLastRowSour As Long


    Set wb = ActiveWorkbook
    wb.Worksheets.Add

    Set wsDest = ActiveSheet
    wsDest.Move After:=Sheets(wb.Sheets.Count)

    'Write Header in Sheet 5
    wsDest.Cells(1, 1) = "Product"
    wsDest.Cells(1, 2) = "Risk"
    wsDest.Cells(1, 3) = "Type"
    wsDest.Cells(1, 4) = "Devision"
    wsDest.Cells(1, 5) = "Name"



    For i = 1 To 4 'Loop for all Sheets

        Set wsSour = wb.Sheets(i)

        lngLastRowDest = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row
        lngLastRowSour = wsSour.Range("A" & wsSour.Rows.Count).End(xlUp).Row
        For j = 1 To 5 'Loop for all Col
            strSearch = wsDest.Cells(1, j).Value

            Call getHeaderRowAndCol(wsSour, intRowHeader, intColHeader, strSearch)

            Range(Cells(intRowHeader + 1, intColHeader), Cells(lngLastRowSour, intColHeader)).Select
            Selection.Copy wsDest.Cells(lngLastRowDest + 1, j)


        Next j

    Next i

End Sub


'Datum:         20.07.17
'Autohr:        Moosli
'Definition:    This sub returns Row and Col Index of the Par. strSearch
'Parameter:     ws as Worksheet (Worksheet(Tabelle) in which is Seaching for the Par.)
'               intRowHeader as Integer, Par for storing the Row Nr.
'               intCol as Integer, Par for storing the Col Nr.
'               strSearch as String, what you want to search... ^^

Private Sub getHeaderRowAndCol(ByVal ws As Worksheet, ByRef intRowHeader As Integer, ByRef intCol As Integer, strSearch As String)
 'Get Header Row
    ws.Activate
    ws.Cells(1, 1).Select
    'Zelle wird gesucht
    On Error GoTo Err_Handler2:
    ws.Cells.Find(What:=strSearch, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, searchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=True, SearchFormat:=False).Activate
    'Spalte und Zeile werden Ausgelesen
    intRowHeader = ActiveCell.Row
    intCol = ActiveCell.Column
Err_Handler2:
End Sub

宏将4个工作表中的5列复制到新工作表中的5列中

2 个答案: