Compile 2 Lists On 2 Pages Into 1

Foxxy1 · May 31st 2007

Here's some code that I got from an old thread.

Code

Sub ThreeToOne() 
    Dim ColALen As Long, ColBLen As Long, ColCLen As Long 
    ColALen =  Range("A65536").End(xlUp).Row 
    ColBLen = Range("B65536").End(xlUp).Row 
    ColCLen = Range("C65536").End(xlUp).Row 
    If ColALen + ColBLen + ColCLen > 65536 Then 
         MsgBox "Too Much Data to fit in One column" 
        Exit Sub 
    End If 
    Range(Cells(1, 1), Cells(ColALen, 1)).Copy _ 
    Range(Cells(1, 5), Cells(ColALen, 5)) 
    Range(Cells(1, 2), Cells(ColBLen, 2)).Copy _ 
    Range(Cells(ColALen + 1, 5), Cells(ColALen + ColBLen, 5)) 
    Range(Cells(1, 3), Cells(ColCLen, 3)).Copy _ 
    Range(Cells(ColALen + ColBLen + 1, 5), Cells(ColALen + ColBLen + ColCLen, 5)) 
End Sub

Display More

I'd like to do something similar, yet different. I have 4 columns on 2 pages that I'd like to combine this time around. I'd like to end up with this as my result.

Sheet1ColumnA Sheet1ColumnB Sheet1ColumnC Sheet1ColumnD
Sheet2ColumnA Sheet2ColumnB Sheet2ColumnC Sheet2ColumnD

Thanks in advance.

Anonymous · May 31st 2007

Re: Compile 2 Lists On 2 Pages Into 1

If I red it correctly, it sounds like you just need to insert a column before column A on each sheet. (delete the new column E -- old column D) if you have data to the right that needs to stay in the same columns.

Foxxy1 · May 31st 2007

Re: Compile 2 Lists On 2 Pages Into 1

Well the code above takes 3 colums from one worksheet and makes them one column on the same sheet. What I need should be more clear from the example below.

Sheet 1
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 C3 D3

Sheet 2
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 C3 D3

Now those two will be compiled into one
Sheet 3
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 C3 D3
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 C3 D3

Does that make sense?

Foxxy1 · Jun 1st 2007

Re: Compile 2 Lists On 2 Pages Into 1

Anyone have any idea if this is even possible? It's gotta be, right?

Arthur494 · Jun 1st 2007

Re: Compile 2 Lists On 2 Pages Into 1

Maybe this?

Code

Sub FourtoTwo()
    Dim ColA1Len As Long, ColA2Len As Long
'   Assuming that the columns A and B are the same length
    ColA1Len = Sheets(1).Range("A65536").End(xlUp).Row
    ColA2Len = Sheets(2).Range("A65536").End(xlUp).Row
   
    If ColA1Len + ColA2Len > 65536 Then
         MsgBox "Too Much Data to fit in One column"
        Exit Sub
    End If
    Worksheets(1).Select
    Range(Cells(1, 1), Cells(ColA1Len, 2)).Copy
    Worksheets(3).Select
    Range(Cells(1, 1), Cells(ColA1Len, 2)).Select
    ActiveSheet.Paste
    Worksheets(2).Select
    Range(Cells(1, 1), Cells(ColA2Len, 2)).Copy
    Worksheets(3).Select
    Range(Cells(ColA1Len + 1, 1), Cells(ColA1Len + ColA2Len, 2)).Select
    ActiveSheet.Paste
End Sub

Display More

Wigi · Jun 2nd 2007

Re: Compile 2 Lists On 2 Pages Into 1

Arthur

You generally don't need to select.

Code

Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    
    Set sh1 = Sheets(1)
    Set sh2 = Sheets(2)
    Set sh3 = Sheets(3)
    
    Range(sh1.Cells(1), sh1.Cells(ColA1Len, 2)).Copy sh3.Cells(1)
    Range(sh2.Cells(1), sh2.Cells(ColA2Len, 2)).Copy sh3.Range(sh3.Cells(ColA1Len + 1, 1), sh3.Cells(ColA1Len + ColA2Len, 2))

untested code

Wigi

jindon · Jun 2nd 2007

Re: Compile 2 Lists On 2 Pages Into 1

try

Code

Sub test() 
    If Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row + _
       Sheets("Sheet2").Range("a" & Rows.Count).End(xlUp).Row > Rows.Count Then 
         MsgBox "Too Much Data to fit in One Sheet" 
         Exit Sub 
    End If 
    With Sheets("Sheet1")
         .Range("a1",.Range("a" & Rows.Count).End(xlUp)).Resize(,4).Copy _
         Sheets("Sheet3").Range("a1")
    End With
    With Sheets("Sheet2")
         .Range("a1",.Range("a" & Rows.Count).End(xlUp)).Resize(,4).Copy _
         Sheets("sheet3").Range("a" & Rows.Count).End(xlUp).Offset(1)
     End With
End Sub

Display More

Foxxy1 · Jun 4th 2007

Re: Compile 2 Lists On 2 Pages Into 1

Thanks guys, works great.

Compile 2 Lists On 2 Pages Into 1

Participate now!

Share

Users Viewing This Thread