Excel data not displaying - vba

Question

I have data that doesnt seem to be merging all the rows! I need it to merge even with empty columns.
For example:
On Sheet CPW, Column W is blank. So when merged all the entries for CPW should show blank in Column W and the information from Sheet CCI would only show.
That's just one example. There are many more on these two sheets.
This is my code for the merge. How can it be edited to do what I require?
Sub Combine()
Dim J As Integer
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim r1, r2, r3, r4, ra, rb, rc, rd, re, rf, rg As Range
Sheets("Sheet2").Select
Set r1 = Range("A:C")
Set r2 = Range("E:X")
Set r3 = Range("Y:AW")
Set r4 = Range("AX:BK")
Sheets("Sheet3").Select
Set ra = Range("A:A")
Set rb = Range("C:C")
Set rc = Range("B:B")
Set rd = Range("D:G")
Set re = Range("I:AL")
Set rf = Range("AM:AP")
Set rg = Range("AQ:BK")
Set wrk = Workbooks.Add
ActiveWorkbook.Sheets(2).Activate
Sheets(2).Name = "CPW"
r1.Copy Range("A1")
r2.Copy Range("D1")
r3.Copy Range("Y1")
r4.Copy Range("AY1")
Range("A1:BK100").Font.ColorIndex = 3
ActiveWorkbook.Sheets(3).Activate
Sheets(3).Name = "CCI"
ra.Copy Range("A1")
rb.Copy Range("B1")
rc.Copy Range("C1")
rd.Copy Range("D1")
re.Copy Range("H1")
rf.Copy Range("AM1")
rg.Copy Range("AQ1")
On Error Resume Next
Sheets(1).Select
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A2").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Sheets(1).Select
Range("A1:BK1000").Sort _
Key1:=Range("E1"), Key2:=Range("J1"), Header:=xlYes
Next
End Sub

Answer 1

Use of Select and Activate is not recommended (unless essential to the code’s objectives) because they are slow commands and are confusing.
You have blank columns because your copies do not line up. With the creation of the source ranges so far from their use, this is not obvious.
My macro achieves the same result as yours. I have bought all the code for copying together so it is much more obvious where you have left gaps. I have included questions where I suspect your code does not do what you want. I have included comments explaining aspects of your code I do not like.
Work through my code and study how I have achieved the same effects as yours. Come back with questions as necessary but the more you can understand on your own, the faster you will develop your skills.
Option Explicit
Sub Combine()
' Here it does not really matter since J is only used in a small block of
' code but avoid names like J. When you return to update this macro in
' 12 months will you remember what J is? I have a system of names that I
' have used for years. I can look at a macro I wrote 5 years ago and
' immediately know what all the variables. This speeds the work of
' remembering what the macro did. If you do not like my naming system,
' design your own but have a system.
' "Integer" defines a 16-bit integer which requires special processing on
' a post-16-bit computer. Use Long which defines a 32-bit integer
'Dim J As Integer
Dim InxWsht As Long
Dim WbkThis As Workbook
Dim Rng As Range
Dim Row1Next As Long
Dim WbkNew As Workbook
Dim WshtNew2 As Worksheet
Dim WshtNew3 As Worksheet
Dim WshtThis2 As Worksheet
Dim WshtThis3 As Worksheet
' ThisWorkbook is the workbook containing the macro. It is not
' necessarily the active workbook
Set WbkThis = ThisWorkbook
Set WshtThis2 = WbkThis.Worksheets("Sheet2")
Set WshtThis3 = WbkThis.Worksheets("Sheet3")
Set WbkNew = Workbooks.Add
Set WshtNew2 = WbkNew.Worksheets(2)
Set WshtNew3 = WbkNew.Worksheets(3)
WshtNew2.Name = "CPW"
WshtThis2.Range("A:C").Copy Destination:=WshtNew2.Range("A1")
' Note columns E:X are written to columns D:W. X is left blank
WshtThis2.Range("E:X").Copy Destination:=WshtNew2.Range("D1")
WshtThis2.Range("Y:AW").Copy Destination:=WshtNew2.Range("Y1")
' Note the previous destination end in column AW while the next
' starts with AY. Column AX is left blank.
WshtThis2.Range("AX:BK").Copy Destination:=WshtNew2.Range("AY1")
' Why are only the first hundred rows coloured red?
' Why don't you colour column BL?
WshtNew2.Range("A1:BK100").Font.ColorIndex = 3
WshtNew3.Name = "CCI"
WshtThis3.Range("A:A").Copy Destination:=WshtNew3.Range("A1")
' Did you mean to reverse columns B and C?
WshtThis3.Range("B:B").Copy Destination:=WshtNew3.Range("C1")
WshtThis3.Range("C:C").Copy Destination:=WshtNew3.Range("B1")
WshtThis3.Range("D:G").Copy Destination:=WshtNew3.Range("D1")
WshtThis3.Range("I:AL").Copy Destination:=WshtNew3.Range("H1")
WshtThis3.Range("AM:AP").Copy Destination:=WshtNew3.Range("AM1")
WshtThis3.Range("AQ:BK").Copy Destination:=WshtNew3.Range("AQ1")
'On Error Resume Next
' This statement means ignore all errors which you should never do.
' Use this statement so:
'On Error Resume Next
'Statement that may fail for reasons you cannot control or stop
'On Error GoTo 0
'If Err.Number = 0 Then
' No error
'Else
' Display Err.Description or take corrective action according
' to value of Err.Number
'End If
'Selection.CurrentRegion.Select
' Since you have just created the worksheet it is probably safe to
' use "CurrentRegion". However, Excel's definition of CurrentRegion
' is not always what you might expect.
With WbkNew
With .Worksheets(1)
.Name = "Combined"
' Did you mean to copy row 2?
WshtNew2.Rows(2).Copy Destination:=.Rows(1)
End With
Row1Next = 3 ' Next free row in worksheets(1)
For InxWsht = 2 To Worksheets.Count
' This Find searches backwards from A1 by row for the first cell
' containing a value. This will give you what you expect more
' often that CurrentRegion
With Worksheets(InxWsht)
Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Rng Is Nothing Then
' Probably not necessary here but best to be safe. If a worksheet
' is empty Find will return Nothing
Else
.Rows("2:" & Rng.Row).Copy Destination:=WbkNew.Worksheets(1).Cells(Row1Next, 1)
' Unless I absolutely know that column A will be the last column with
' a value, I prefer to caluclate the next free row.
Row1Next = Row1Next + Rng.Row - 1
End If
End With
Next
' I do not see the point of having the Sort within the or Loop
With .Worksheets(1)
.Cells.Sort Key1:=.Range("E1"), Key2:=Range("J1"), Header:=xlYes
End With
End With
End Sub