我的数据似乎并没有合并所有行！我需要它甚至与空列合并。
例如：
在 Sheet CPW 上，列W 为空。因此，当合并时， CPW 的所有条目都应在列W中显示为空白，而 Sheet CCI 中的信息仅显示。
这只是一个例子。这两张纸上还有很多 这是我的合并代码。如何进行编辑以满足我的要求？
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
答案 0 :(得分：0)
不推荐使用Select和Activate（除非代码的目标必不可少），因为它们命令很慢并且令人困惑。
您有空白列，因为您的副本没有对齐。由于源范围的创建远远超出了它们的使用范围，因此这并不明显。
我的宏取得了与你相同的结果。我已经购买了所有用于复制的代码，所以在你留下空白的地方更加明显。我已经包含了一些问题，我怀疑你的代码没有做你想要的。我已经包含了解释我不喜欢的代码方面的评论。
完成我的代码并研究我是如何获得与您相同的效果的。尽可能回答问题，但是你自己能够理解的越多，你发展技能的速度就越快。
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