combining worksheets macro

[etaf]

i was advised by dreamboat from a different forum to post my problem here.

heres the post

thanks dreamboat had a look at those links - one works perfectly
but this one
http://www.vbaexpress.com/kb/getart...kb_id=151#instr
does not seem to work.
i have 3 worksheets, with data in
all it copies over is the name of the worksheet into column A and repeats that down the rows for the same number of records
so worksheet 1 called one has 20 rows
worksheet 2 called two has 24rows
worksheet 3 called three has 10 rows
I get in column A
the word one repeated 20 time in the rows
under that I get
the word two repeated 24 times in the rows
under that I get
the word three repeated 10 times

should i be altering the macor for the columns - the code looks like it counts those

I wanted to be able to combine data from a number of worksheets into one worksheet and was advised to look at this site and an example - see url below {seems that anything i type after the url is hyperlinked and underlined }
I tried this on some sample data and it did not work
I have attached an example {note the data will be across about 30 columns } spreadsheet of the worksheets and results.
can anyone advise if i need to make anychanges to this macro to work.



http://www.vbaexpress.com/kb/getarti...b_id=151#instr

[austenr]

Something like this perhaps:

Dim Wkbk As Workbook
Dim wksht As Worksheet
Dim destWks As Worksheet
Dim destCell As Range
Dim drow As Integer
Set Wkbk = Workbooks("ajx.xls")
Set destWks = Workbooks("combined.xls").Worksheets("sheet1")
drow = 1
For Each wksht In Wkbk.Worksheets
With destWks
Set destCell = .Cells(drow, 1)
End With
wksht.Range("J12:O12").Copy
destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
drow = drow + 1
Next

[etaf]

well it only copies one row I need to copy a lot of rows and columns -
as in the example but about 30 columns
i had hoped the example in the ur would do the job

[Zack Barresse]

Hello etaf, nice to see you here!

Can you explain the variables in the sheets you have? Such as will they always have the same amount of columns? Will the columns vary from sheet to sheet, or will it be one common length for the entire workbook?

I'm assuming you want this as a standard routine, not triggered from a specific event? Or were you wanting this as an add-in, or possibly a self-sustaining toolbar/commandbar?

[etaf]

Thanks for the welcome, i posted on techguys and dreamboat sent me here
http://forums.techguy.org/t345131.html

the worksheets are all identical in columns - the number of rows may vary.

Such as will they always have the same amount of columns?

YES

Will the columns vary from sheet to sheet

NO

or will it be one common length for the entire workbook?

The worksheet rows may vary

I'm assuming you want this as a standard routine, not triggered from a specific event? Or were you wanting this as an add-in, or possibly a self-sustaining toolbar/commandbar?

No it will be run ONCE only and combining 200 worksheets into one worksheet for import into an access database.

the description in the url described exactly what i thought i needed it just didnt work.

I will have 200 workbooks all being submitted over a 5week period. The example here for pulling workbooks from a directory into seperate sheets in one workbook works great, and then combine the worksheets into one - just did not work

this worked great
http://www.vbaexpress.com/kb/getarticle.php?kb_id=221

this did not work
http://www.vbaexpress.com/kb/getarticle.php?kb_id=151

[Zack Barresse]

Okay, so you have all the worksheets into one workbook, yes?

And those are the only sheets in this workbook?

I'll whip up a macro, but wait to post it until you respond to this.

[etaf]

yea - all in one book and the only sheets in the book

[Zack Barresse]

Try this ...

Option Explicit

Sub CombineMySheets()
    Dim ws As Worksheet, newWs As Worksheet, wsRow As Long, newRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set newWs = Sheets.Add(before:=Sheets(1))
    Sheets(2).Rows("1:1").Copy newWs.Rows("1:1")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> newWs.Name Then
            newRow = newWs.Range("A65536").End(xlUp).Row + 1
            wsRow = ws.Range("A65536").End(xlUp).Row
            ws.Range("A2", ws.Cells(wsRow, 30)).Copy newWs.Cells(newRow, 1)
        End If
    Next ws
    newWs.Name = "Master" 'Must not be duplicated
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

** EDIT: Btw, I assumed you wanted 30 columns, as stated, so that part is hardcoded. We can change it to dynamic if you'd like.

[etaf]

some of the data is referenced a fixed cells
so for example column B is fixed reference to $C$2
so when I copy across it also copies the formula and so changes the data
is there an easyway so that each sheet is changed to
copy - paste special Values
before they are combined

[Zack Barresse]

In that case, change out this line ...

newRow = newWs.Range("A65536").End(xlUp).Row + 1

.. with this line ...

newRow = newWs.UsedRange.Rows.Count + 1

The major caveat to this method is Excel can throw off the UsedRange in a worksheet fairly easily. Not being foolproof, there has (of course) been a routine to counteract this (really stupid) caveat, found here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=83. This code would be run just once, and before you ran the code I have supplied.

If you do experience problems with these, we will take a more manual route.

[etaf]

sorry i edited my post just as you replied
some of the data is referenced a fixed cells
so for example column B is fixed reference to $C$2
so when I copy across it also copies the formula and so changes the data
is there an easyway so that each sheet is changed to
copy - paste special Values
before they are cmbined

so just data rather then formula

sorry to have mucked you around, my mistake in what it was doing
it does copy all the worksheets OK - just copying formula

[Zack Barresse]

Okay, revised ...

Option Explicit

Sub CombineMySheets()
    Dim ws As Worksheet, newWs As Worksheet, wsRow As Long, newRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set newWs = Sheets.Add(before:=Sheets(1))
    Sheets(2).Rows("1:1").Copy newWs.Rows("1:1")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> newWs.Name Then
            newRow = newWs.UsedRange.Rows.Count + 1
            wsRow = ws.UsedRange.Rows.Count
            ws.Range("A2", ws.Cells(wsRow, 30)).Copy
            newWs.Cells(newRow, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
        End If
    Next ws
    newWs.Name = "Master" 'Must not be duplicated
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Etaf, note you will have to run the clean-up code if you use the workbook you attached. You can also use ASAP Utilities (ASAP Utilities | Sheets | Remove unused rows/columns from sheet). To test, from any sheet press F5 --> Last Cell. See the row it's on?

After doing that, this routine runs fine for me. Let me know if you need anything else.

[etaf]

Perfect - thanks very much for that - sorry for mucking around with wrong info - i'll go anmd play and test fully now - but looks OK on some test data

[Zack Barresse]

Etaf, if this works ok for you, you can mark your threads Solved here just like you can at TSG.

Hope if worked out for you!

[gsouza]

Sub ConsolLoop()
warning = MsgBox("This macro will consolidate data on all sheets." & vbCrLf & " ", 4, "Warning")
If warning = vbNo Then
Range("A1").Select
Else:
Application.ScreenUpdating = False
Sheets(5).Select
Cells.ClearContents
r = 0
N = 0
For i = 2 To 4
Sheets(i).Select
GoSub DoCopy
GoSub DoPaste
N = N + r
Next i
Exit Sub
DoCopy:
Cells(1, 1).CurrentRegion.Select
Selection.COPY
r = Selection.Rows.Count
Return
DoPaste:
Sheets(5).Select
Cells(1, 1).Offset(N, 0).Select
ActiveSheet.Paste
Return
End If
Application.ScreenUpdating = True
End Sub