Copy multiple; sheets into one

Lookatthis123

New member
Local time
Yesterday, 20:26
Joined
Aug 30, 2007
Messages
7
Hello all I was wonders if anyone knows how to do the following I know very little about code and all I really know is to copy and past it into Excel so any help would be appreciated.

I would like to copy information from several spreadsheets lets say from Sheet 1 to Sheet 200 all data to be copied into one sheet named Master.
Maybe a range would also be required per sheet so I don’t end up with a lot of blank lines.

The sample code I have copies but only the last page gets copied. Please help.

Here is the code:

Sub CopyIntoOne()
For Each thing In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "sheet6", "sheet7", "sheet8")
Sheets(thing).Range("A1:DV10000").Copy
Sheets("Master").Range("A65536").End(xlUp).Offset(1).PasteSpecial
Next
End Sub
 
Sorry, I have been extremely busy; rush projects no longer are occasional requests, but a daily occurrence. Hence my participation on most boards has dropped dramatically.
________
Mflb
 
Last edited:
Thanks shades I'm still on step one.
Remind me how your answer helps my question did you not understand it if not then say so and I can try to clarify instead of pointing me to a link on how to ask questions.
 
Last edited:
Being an ACCESS forum there are not too many EXCEL experts and the code to answer your question is more complex, my 1st feeble attempt failed, I will visit again if I can find time.

Shades link on how to ask questions is a standard part of his signature not directed specifically at you.

Brian
 
You could try something like this .

PHP:
Sub copysheetsinto1()
'Brian Warnock 12 December 2007

Dim x As Integer
Dim y As Integer
Dim n As Integer
Dim lngLastRow As Long
n = 1
y = 1

Do
'loopsheets

With Sheets(n).UsedRange
lngLastRow = .Cells(1, 1).Row + .Rows.Count - 1
End With
x = 1

Application.ScreenUpdating = False

Do
'looprows
Sheets(n).Select
Cells(x, 1).EntireRow.Copy
Sheets("master").Select
Cells(y, 1).Select
ActiveSheet.Paste

y = y + 1
x = x + 1

Loop Until x > lngLastRow
n = n + 1
Loop Until n = 14  'or 1 more than the sheets to be copied
Application.ScreenUpdating = True

End Sub


Brian

ps no idea were the colour coding came from
 
I was wondering if my code solved the problem, but on checking I see that Lookat hasn't been back to look at it. :confused:

Brian
 

Users who are viewing this thread

Back
Top Bottom