Thread: Merge worksheets

Hi everyone. I have been trying to work out a macro to merge several hundred worksheets into one, but all I have accomplished is transposition of some of the information in rows instead of columns, needless to say I am very new at this.

I have attached two files. One is called "Combined within Target Prices DS" and the other one is called "Merged worksheets". The information in the Target prices DS files is of daily stock prices of companies and each worksheet represents one company. What I am trying to do is merge all the worksheets to one worksheet (Merged worksheets) and reposition the information, as it is shown in the merged file. Company ID found in the Target prices should be written in each cell of the merged file as well as the name of the company under "comnam", respective to the dates of closing stock prices.

At my current level I am not proficient enough to figure out how to do it. Please, if anyone of you have the time and the patience, help me. I would greatly appreciate it!

I am on Office 2007

I was unable to attach the files to the messages, it seems that there are some issues with the function as it didn't upload the files. The two files can be found here: http://www.mediafire.com/?snx1ab99oy4b0zb and http://www.mediafire.com/?d3dexoxtsal00vn

Hi randomintel
Been working on this today along with Forum Issues. I'm including some code that appears to do as you require but, I need you to accommodate me for a moment. I'll ask you to do this:
Save your "Combined within Targets prices DS.xls" as an .xlsx file with the Name "Source.xlsx". Save your "Merged worksheets.xlsx" as "Target.xlsm". Bear with me...the issues on the Forum have been quite frustrating...I believe we may have a small window of opportunity at this point in time.

Place these two files ("Source.xlsx" and "Target.xlsm") in the same folder. The code runs from "Target.xlsm". Place this code in "Target.xlsm"...do you know how to do that...if not let me know...then run the code on a COPY of your file (named "Source.xlsx"). Open "Target.xlsm" ("Source.xlsx" SHOULD NOT BE OPEN...the procedure will open it).

Option Explicit
Sub test1()
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim MyPath As String
    Dim tNR As Long
    Dim sLR As Long
    Dim tLR As Long
    Dim xlCalc As XlCalculation
    
    On Error GoTo ExitPoint
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    MyPath = ActiveWorkbook.Path

    Set wbTarget = ThisWorkbook
    Set wsTarget = wbTarget.Sheets("Sheet1")
    Application.Workbooks.Open (MyPath & "\" & "Source.xlsx")
    Set wbSource = Workbooks("Source.xlsx")
    For Each wsSource In wbSource.Sheets
        With wsSource
            sLR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
            .Range("B4").Copy Destination:=.Range("C5")
            .Range("A6:B" & sLR).Copy Destination:=.Range("D5:E5")
            .Range("A6:B" & sLR).ClearContents
            Application.CutCopyMode = False
            .Rows("1:4").Delete Shift:=xlUp
            .Columns(1).Delete
            sLR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
        End With

        With wsTarget
            tNR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            wsSource.Range("A1:D" & sLR).Copy
            .Range("A" & tNR).PasteSpecial
             Application.CutCopyMode = False
            tLR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
            .Range("A" & tNR) = Val(.Range("A" & tNR))
            .Range("A" & tNR & ":A" & tLR).Value = .Range("A" & tNR).Value
            .Range("B" & tNR & ":B" & tLR).Value = .Range("B" & tNR).Value
'            .Range("E" & tNR).Value = wsSource.Name
        End With
    Next wsSource
ExitPoint:
    wbSource.Close False, False
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

I know this is a bit oblique...the forum has been a bit squirrelly of late...don't usually do things in this manner. If this doesn't translate, perhaps tomorrow will be a better day.

Hi randomintel
Gonna go out on a limb here and try to attach my work files. One will be zipped.
Didn't work...will try later.

9:47pm...still no luck uploading.