VBA-Copy specific Column Data from multiple worksheets into one

Question

I have a very typical scenario where two columns from different worksheets(in same workbook) needs to be copied to single worksheet.

Source workbook name: Mycalc.xlsm

Worksheets name: Sheet1, sheet2, sheet3 (There are other sheets as well but action t o be performed only for the mentioned)

Target Workbook Name: Mycalc.xlsm

Target worksheet name: Merged

Condition:

Cannot do for each for all worksheets in the the workbook as the action to be performed only on the mentioned three sheets.
The columns headers are not necessarily in same order in all sheets but the header is same.

enter image description here

Result Expected: The resultant is a consolidated data from all 3 sheets along with a column sheetname mentioning the sheet where data copied.

I am no expert in this and hence i am not pasting the code whatever i have achieved. Adding to it, I have approached by adding the sheet name in a named range as list (in a workbook i created a table having the list of sheet names and for each is performed on that range).

enter image description here

The experts of stackoverflow, please help me.

Regards,

Mani

Recommendation one: Use the [Worksheets(shname).Cells.Find](https://msdn.microsoft.com/en-us/library/office/ff839746.aspx) method, retrieve the header's column (and row since you didn't even make them uniform). Use the same method to retrieve their [last rows](http://stackoverflow.com/a/25509398/3819867). — user3819867, Mar 10 '15 at 11:30
@katz .Please read with attention, i've clearly mentioned that i have not pasted my code to make the question simple and also i have also mentioned the approach. Nobody here requires service, its a forum which means discussion and helping. — Manivannan KG, Mar 10 '15 at 23:53
@katz please find my code and works done. Hope you're happy now. Please be sure before down voting a question because it costs reputation (pts). — Manivannan KG, Mar 11 '15 at 06:17
@ManivannanKG I haven't downvoted your question, I've just left a comment... — Kᴀτᴢ, Mar 11 '15 at 11:36

score 1 · Answer 1 · answered Mar 11 '15 at 03:30

I have used the concept of named range for the sheet names. After lot of hurdles and time consuming research. Here is a simple, compiles and working code.

Public Sub ExportData()

Dim TransCol(1 To 2) As String
Dim ImportWS As Worksheet
Dim SheetsName As Range
Dim FindColumn, TargetColumn As Range
Dim RowCount As Long
Dim RowIndex, i, Column  As Long
Dim LastUsedRow As Long
Dim LastUsedRowCount As Variant


    TransCol(1) = "ISIN"
    TransCol(2) = "Current Day Adjustment"



For Each SheetsName In sheet3.Range("tblSheetNames").Cells

 If Len(SheetsName.Value) > 0 Then

 Set ImportWS = ThisWorkbook.Sheets(SheetsName.Value)
 ImportWS.Activate

 For Column = 1 To 2

 Set FindColumn = ImportWS.Cells.Find(TransCol(Column), searchorder:=xlByRows, searchdirection:=xlNext)
     RowCount = FindColumn.Cells(200000, 1).End(xlUp).Row
 Set TargetColumn = sheet3.Cells.Find(TransCol(Column), searchorder:=xlByRows, searchdirection:=xlNext)

For i = FindColumn.Row To RowCount

    LastUsedRow = sheet3.Cells(200000, TargetColumn.Column).End(xlUp).Row
    sheet3.Cells(LastUsedRow + 1, TargetColumn.Column).Value = ImportWS.Cells(i + 1, FindColumn.Column).Value

 Next i

 Next Column
End If

Next
End Sub

**Note:**I have moved the code to the module than the workbook code behind.

Happy to explain, if more info is required. Thank you All.

Regards,

Mani

score 0 · Answer 2 · answered Mar 10 '15 at 12:23

You don't deserve a sub from scratch, made no uniformization or efforts otherwise to get anywhere.
Since you're apparently not intending to learn either I didn't really bother commenting the code. If I'm wrong and you would like to learn what these lines are doing feel free to comment under and I'll respond.

Sub ertdfgcvb()
ExportWS = "Merged"
Dim ImportWS(1 To 3) As String
    ImportWS(1) = "Sheet1"
    ImportWS(2) = "sheet2"
    ImportWS(3) = "sheet3"
Dim TransCol(1 To 2) As String
    TransCol(1) = "Current Day Adjustment"
    TransCol(2) = "ISIN"
For i = 1 To 3 'for each import sheet
    FirstImportRow = Worksheets(ImportWS(i)).Cells.Find(TransCol(1), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 1
    LastImportRow = Worksheets(ImportWS(i)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DiffRows = LastImportRow - FirstImportRow
    FirstExportRow = Worksheets(ExportWS).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    ExportColumn = Worksheets(ExportWS).Cells.Find("Sheet Name", SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the sheet name
    Worksheets(ExportWS).Range(Cells(FirstExportRow, ExportColumn), Cells(FirstExportRow + DiffRows, ExportColumn)) = ImportWS(i)
    For j = 1 To 2 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        ImportColumn = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data from
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
    Next

Next
End Sub

Thank you @user3819867.It was not a compiled or tested version i believe. Added the looping is too heavy.I have come up with simple concepts. But really appreciate your efforts and helping tendency. — Manivannan KG, Mar 11 '15 at 03:25

VBA-Copy specific Column Data from multiple worksheets into one

2 Answers2