MagicMike
10-16-2008, 11:50 AM
Hello again,
Here is my latest problem in this project that I'm working on. I have about 20 individual sheets that are all the same format but contain different work order number data. I would like all of the sheet data to be populated on a single sheet (All_WO).
I have modified the example below that I have found on the MSDN site to mostly work but here are my problems:
1. I only want the data to start populating the All_WO sheet starting on row A6 and dont need to look beyond column Q. No matter what I do the data starts to populate on row 5 and overrwrites my header rows (1-5)
2. My problem is that even with the help text I still dont really understand what each part of the code is doing.
'Consolodate all WO sheet data to "All_WO" sheets worksheet FUNCTION
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'Consolodate all WO sheet data to "All_WO" sheets worksheet SUB
Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Clear current summary data
ThisWorkbook.Worksheets("All_WO").Rows("6:65536").Delete
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets("All_WO")
DestSh.Name = "All_WO"
' Fill in the start row.
StartRow = 6
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Sheets(Array("260", "400", "410", "430", "440", "490", "500", "510", "520", "530", "540", "550", "580", "590", "600", "610", "660", "700", "710"))
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
'DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
If I could get it not to overwrite row 5 I'd be good I think for now.
Thanks,
-Mike
Here is my latest problem in this project that I'm working on. I have about 20 individual sheets that are all the same format but contain different work order number data. I would like all of the sheet data to be populated on a single sheet (All_WO).
I have modified the example below that I have found on the MSDN site to mostly work but here are my problems:
1. I only want the data to start populating the All_WO sheet starting on row A6 and dont need to look beyond column Q. No matter what I do the data starts to populate on row 5 and overrwrites my header rows (1-5)
2. My problem is that even with the help text I still dont really understand what each part of the code is doing.
'Consolodate all WO sheet data to "All_WO" sheets worksheet FUNCTION
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'Consolodate all WO sheet data to "All_WO" sheets worksheet SUB
Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Clear current summary data
ThisWorkbook.Worksheets("All_WO").Rows("6:65536").Delete
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets("All_WO")
DestSh.Name = "All_WO"
' Fill in the start row.
StartRow = 6
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Sheets(Array("260", "400", "410", "430", "440", "490", "500", "510", "520", "530", "540", "550", "580", "590", "600", "610", "660", "700", "710"))
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
'DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
If I could get it not to overwrite row 5 I'd be good I think for now.
Thanks,
-Mike