Macro to copy 5 columns from 4 sheets into 5 columns in a new sheet

0
votes

I have a excel file with 4 sheets. The sheets are named Sheet 1, Sheet 2 , Sheet 3 and Sheet 4.

Each sheet has 5 columns (Product, Risk, Type, Division, Name) that I want to copy to a new sheet (Sheet 5). Each sheet has a different structure so the columns are not the same. I want to copy all of the data in the Product columns into Column A in Sheet 5, all of the data in the Risk columns into Column B in sheet 5 and so on. The final result will have 5 columns (Product, Risk, Type, Division, Name). The number of rows of data in Sheets 1 to 4 is all different.

Can somebody please help? I cannot attach the file as it confidential. Thanks

2
vbaexcel
Please understand that people are here to help/assist you to solve your issue yourself not to do the work for you and write the solution for you. So in general we need some code from you where we can show what is wrong and where to fix it. Also read How to ask. – Moosli
what do you mean with diffrent structure? For a better understanding, can you post a screen shot of sheet 1 to sheet 4 with dummy data, so you don't have to post confidential data. And can you post some of your code that you tried? – Moosli

2 Answers

1
votes

Happened to me once, had to summirize multiple Workbooks with multiple Sheets each in one separate Workbook.
Since I can't see code nor screenshot I can only suggest common things.
1.) If names of needed columns are named identicaly for each sheet you can use .find to determine number of the column and draw data from there (from last to first row + 1 (since 1st used row will be probably a header)). 

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

Where ColumnName is the name of a header in new Sheet.

I will update answer with more suggestions with more revealed details on this file structure.

1
votes

You got luck, that' i hade a once the same Problem. Hope this can help you.

'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