Solved: combine data from spreadsheet help

[shrimp]

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.

[vba]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
[/vba] Is there a simple way to adjust this code? Any help will be greatly appreciated. Thanks!

[CodeNinja]

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]

Thanks, Ninja. With these changes is stops at Ln11, Col9. See below.

[VBA]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[/VBA]

[CodeNinja]

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.

[VBA]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[/VBA]

[Tinbendr]

Check out Ron's page as well for some more examples and add-ins.

[fredlo2010]

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

So here it is.

[VBA]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
[/VBA]

[Tinbendr]

a function to check if a sheet already exists

We also have examples in our knowledge-base.

Sheet exists1
Sheet Exists2
Sheet Exists3

[shrimp]

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]

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]

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]

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)?


[VBA]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[/VBA]

[CodeNinja]

try
[VBA]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[/VBA]

[fredlo2010]

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.

[VBA]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[/VBA]

[shrimp]

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.