PDA

View Full Version : Solved: combine data from spreadsheet help



shrimp
06-12-2012, 10:08 AM
Hi,

I am new to the forum and new to VBA. I am trying to combine data from multiple worksheets into a single new worksheet. I have 3 worksheets with 1975 rows each. I would like to combine the data from these sheets from left to right in the new sheet. I have found a code that will combine them one on top of the other and don't know how to (or if i can) adjust this code to add these data from left to right.

Sub Combine()
Dim NumSheets As Integer
Dim NumRows As Integer
NumSheets = 3
NumRows = 1975
Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For X = 1 To NumSheets
Worksheets(X + 1).Select
Rows("1:" & NumRows).Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Worksheets(X + 1).Select
Range("A1").Select
Next X
Worksheets("Consolidated").Select
Range("A1").Select
End Sub
Is there a simple way to adjust this code? Any help will be greatly appreciated. Thanks!

CodeNinja
06-12-2012, 11:56 AM
Hi Shrimp,
You should be able to do this by replacing numRows with numColumns...

You will need to change the following code lines:
Instead of numRows = 1975 You will have to put numColumns = (number of columns on each sheet),
Rows("1:" & numRows) to Columns("1:" & numColumns)
selection.end(xldown).select to selection.end(xlToRight).select,
and finally activecell.offset(1,0) to activecell.offset(0,1)

I believe with those changes it will work...

Good luck.

shrimp
06-12-2012, 12:33 PM
Thanks, Ninja. With these changes is stops at Ln11, Col9. See below.

Sub Combine()
Dim NumSheets As Integer
Dim NumColumns As Integer
NumSheets = 3
NumColumns = 38
Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For x = 1 To NumSheets
Worksheets(x + 1).Select
Columns("1:" & NumColumns).Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
Worksheets(x + 1).Select
Range("A1").Select
Next x
Worksheets("Consolidated").Select
Range("A1").Select
End Sub

CodeNinja
06-12-2012, 01:07 PM
Shrimp,
Looks like there were a few additional changes required.... I also changed the columns.select to selecting a range, and since you know it is always to AL, I hard coded that... if you need that to be on the fly let me know...

Good luck.

Sub Combine()
Dim NumSheets As Integer
Dim NumColumns As Integer
NumSheets = 3
NumColumns = 38
Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For x = 1 To NumSheets
Worksheets(x + 1).Select
Range("A:AL").Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste
Sheets("Consolidated").Range("IV1").End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
Worksheets(x + 1).Select
Range("A1").Select
Next x
Worksheets("Consolidated").Select
Range("A1").Select
End Sub

Tinbendr
06-12-2012, 01:19 PM
Check out Ron's page (http://www.rondebruin.nl/copy2.htm) as well for some more examples and add-ins (http://www.rondebruin.nl/addins.htm).

fredlo2010
06-13-2012, 01:23 AM
Hi guys,

I was looking at this thread and the help already provided. I took the freedom to modify CodeNinja' code a little and add some extra features.

So here is my code it also uses a function to check if a sheet already exists I found here (http://www.ozgrid.com/forum/showthread.php?t=58548)

So here it is.

Sub Combine()
Dim NumSheets As Integer
Dim NumColumns As Integer

Application.ScreenUpdating = False

NumSheets = 3
NumColumns = 38

If SheetExists("Consolidated") Then

MsgBox "The sheet Consolidated already exists. Would you like to update the data?", _
vbOKCancel + vbInformation, "Consolidated"

If vbCancel = True Then
Sheets("Consolidated").Range("A1").Select
Else
Sheets("Consolidated").Cells.ClearContents
GoTo Main
End If

Else
Sheets.Add
ActiveSheet.Name = "Consolidated"
Main:
For x = 1 To NumSheets
Worksheets(x + 1).Range("A:AL").Copy Destination:= _
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 1)
Worksheets(x + 1).Select
Range("A1").Select
Next x

With Worksheets("Consolidated")
.Activate
.Columns("A:A").Delete
.Range("A1").Select
End With
End If
Application.ScreenUpdating = True

End Sub

Private Function SheetExists(SheetName As String) As Boolean
Dim ws As Worksheet

SheetExists = False

For Each ws In ThisWorkbook.Worksheets
If ws.Name = SheetName Then SheetExists = True
Next ws

End Function

Tinbendr
06-13-2012, 04:21 AM
a function to check if a sheet already exists We also have examples in our knowledge-base.

Sheet exists1 (http://www.vbaexpress.com/kb/getarticle.php?kb_id=420)
Sheet Exists2 (http://www.vbaexpress.com/kb/getarticle.php?kb_id=355)
Sheet Exists3 (http://www.vbaexpress.com/kb/getarticle.php?kb_id=187)

shrimp
06-13-2012, 04:29 AM
Wow, just got to work this morning and saw all the replies. Thanks everybody!! What a great resource! I hope to be able to contribute as I learn more. Thanks again!

robertflicks
06-13-2012, 07:36 AM
Wow, these was nice discussion going on here. These information is also be very useful and informative to many. I am new here and after looking at this response from all members here I am glad.

fredlo2010
06-13-2012, 01:00 PM
Shrimp,


I hope to be able to contribute as I learn more.

I am sure you will. About a month ago I started learning VBA and I was super lost (Tinbendr can confirm this :) he helped me tons of times). I am not even close to a professional now, but at least I know enough to find my way around

robertflicks,


these was nice discussion going on here

This is something usual to expect from this forum.

shrimp
06-14-2012, 12:49 PM
Let's say I wanted the the data from the second and third sheets to be offset by (0,3) instead of (0,1) in order to keep the same spacing between all sample data. If I simply change the offset here to (0,3) the data from the first sheet will begin in 3 in the "consolidated" sheet. How could I modify this code so only the data from the second and third sheets are offset by (0,3)?


Sub Combine()
Dim NumSheets As Integer
Dim NumColumns As Integer

Application.ScreenUpdating = False

NumSheets = 3
NumColumns = 38

If SheetExists("Consolidated") Then

MsgBox "The sheet Consolidated already exists. Would you like to update the data?", _
vbOKCancel + vbInformation, "Consolidated"

If vbCancel = True Then
Sheets("Consolidated").Range("A1").Select
Else
Sheets("Consolidated").Cells.ClearContents
GoTo Main
End If

Else
Sheets.Add
ActiveSheet.Name = "Consolidated"
Main:
For x = 1 To NumSheets
Worksheets(x + 1).Range("A:AL").Copy Destination:= _
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 1)
Worksheets(x + 1).Select
Range("A1").Select
Next x

With Worksheets("Consolidated")
.Activate
.Columns("A:A").Delete
.Range("A1").Select
End With
End If
Application.ScreenUpdating = True

End Sub

Private Function SheetExists(SheetName As String) As Boolean
Dim ws As Worksheet

SheetExists = False

For Each ws In ThisWorkbook.Worksheets
If ws.Name = SheetName Then SheetExists = True
Next ws

End Function

CodeNinja
06-14-2012, 01:06 PM
try
if x = 1 then
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 1)
else
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 3)
end if

fredlo2010
06-14-2012, 04:47 PM
Hi,

You will have to nest an If statement in the For...Next just like CodeNija suggested.

Here is the complete code. I added a peice of code at the end to auto-fit the columns and center the values. But you can delete it if you want.

Sub Combine()
Dim NumSheets As Integer
Dim NumColumns As Integer

Application.ScreenUpdating = False

NumSheets = 3
NumColumns = 38

If SheetExists("Consolidated") Then

MsgBox "The sheet Consolidated already exists. Would you like to update the data?", _
vbOKCancel + vbInformation, "Consolidated"

If vbCancel = True Then
Sheets("Consolidated").Range("A1").Select
Else
Sheets("Consolidated").Cells.ClearContents
GoTo Main
End If

Else
Sheets.Add
ActiveSheet.Name = "Consolidated"
Main:
For x = 1 To NumSheets

If x = 2 Or x = 3 Then
Worksheets(x + 1).Range("A:AL").Copy Destination:= _
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 3)
Worksheets(x + 1).Select
Range("A1").Select
Else
Worksheets(x + 1).Range("A:AL").Copy Destination:= _
Sheets("Consolidated").Range("IV1").End(xlToLeft).Offset(0, 1)
Worksheets(x + 1).Select
Range("A1").Select
End If
Next x

With Worksheets("Consolidated")
.Activate
.Columns("A:A").Delete
.Range("A1").Select
End With
End If


'I added this, I think it might help you as well but feel free to remove it

With Sheets("Consolidated").Cells
.Columns.AutoFit
.HorizontalAlignment = xlCenter
End With

Application.ScreenUpdating = True

End Sub
Private Function SheetExists(SheetName As String) As Boolean
Dim ws As Worksheet

SheetExists = False

For Each ws In ThisWorkbook.Worksheets
If ws.Name = SheetName Then SheetExists = True
Next ws

End Function

shrimp
06-15-2012, 05:28 AM
Thank you, Ninja and Fredlo. This makes sense. I had already consolidated the 10 workbooks that I needed. I ask this question for learning purposes only. I appreciate you taking the time to respond. As I am new here, please let me know if my questions are crossing the lines of etiquette for the forum.