winfy
07-07-2016, 04:47 PM
Hi all, I found the code to consolidate worksheets into one sheet, but have two questions I am hoping someone can help me with.
1) The sheets are formula based and I just want to paste special values. How can I do that? The code doesn't seem to provide me any way to add it in; and
2) For some reason, the input begins in the directory tab begins in A2, but I want it to begin in B7. All other sheets begin in B7 and I find it strange why it starts in A2.
Any help will be greatly appreciated.
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Directory"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("B10").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
1) The sheets are formula based and I just want to paste special values. How can I do that? The code doesn't seem to provide me any way to add it in; and
2) For some reason, the input begins in the directory tab begins in A2, but I want it to begin in B7. All other sheets begin in B7 and I find it strange why it starts in A2.
Any help will be greatly appreciated.
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Directory"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("B10").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub