Hi All,

I've been running the below scripts for a long time. All of a sudden
I'm getting the 400 Error.

Do need to update the scripts or do I need to install an upgrade.

Separate Columns
Sub CopyColumnPairsToSeparateWorkbooks()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own workBOOK
' Each workbook will be named [email protected]
' where @ is the letter of the adjacent column information in it.
' Each workbook will be saved into the path designated in
' constant newWBSavePath, and that path must already exist
' before running the macro.
' Each of the workbooks is also left open after the save.
'
' Any existing .xls files in that path with names
' that will be created should be moved/deleted so that
' you are not plagued with "file exists, overwrite?"
' prompts.
'
Const newWBSavePath = "c:\temp\" ' must exist!
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer
Dim thisWB As Workbook
Dim newWB As Workbook
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
Set thisWB = ThisWorkbook
srcSheetName = thisWB.ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = thisWB.ActiveSheet.Range(ColAUsedAddress)
Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
thisWB.Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = thisWB.ActiveSheet.Range(anyAddressRange)
' add new WORKBOOK, it becomes active
Workbooks.Add
Set newWB = ActiveWorkbook
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
newWB.ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = newWB.ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = _
newWB.Worksheets(destSheetName).Range(anyAddressRa nge)
'copy to new sheet, column B
destRange.Value = srcRange.Value
'save the new workbook with an appropriate name
'and leave it open
newWB.SaveAs newWBSavePath & destSheetName & ".xls"
thisWB.Activate ' back to this workbook for another round
Set newWB = Nothing
Set destARange = Nothing
Set srcRange = Nothing
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub
Remove Rows with 0 (zero) Value
Sub kill_row()
Set rdel = Range("A65536")
For Each r In ActiveSheet.UsedRange
If Not IsEmpty(r) Then
If r.Value = 0 Then
Set rdel = Union(rdel, r)
End If
End If
Next
rdel.EntireRow.Delete
End Sub
Split into 10000 Rows

Sub testme()
Dim NewWks As Worksheet
Dim ActWks As Worksheet
Dim iRow As Long
Dim myStep As Long


Set ActWks = ActiveSheet
myStep = 10000
With ActWks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step
myStep
Set NewWks = Workbooks.Add(1).Worksheets(1)
.Rows(iRow).Resize(myStep).Copy _
Destination:=NewWks.Range("a1")
Next iRow
End With
End Sub

Rgds,
Dolphy

You did not specify which instruction was causing the error. This
information helps a lot! I ran each of the 3 modules in a blank workbook in
excel 2003 and did not get any errors. You problem may be 1 of two problems.

1) The error is assocciate with some data already entered in the workboook
2) The workbook is corrupted.

First try stepping through the code using the F8 key to try to isolate
problem. Post the code and the data in the worksheet at this site if you
can't figure out the problem yourself.

In some cases when the workbook is corrupted you may have to start a new
workbook and copy the data from old workbook to new workbook. this is rare,
but it happened once today at this site.
"Dolphy" wrote:

Hi All,

I've been running the below scripts for a long time. All of a sudden
I'm getting the 400 Error.

Do need to update the scripts or do I need to install an upgrade.

Separate Columns
Sub CopyColumnPairsToSeparateWorkbooks()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own workBOOK
' Each workbook will be named [email protected]
' where @ is the letter of the adjacent column information in it.
' Each workbook will be saved into the path designated in
' constant newWBSavePath, and that path must already exist
' before running the macro.
' Each of the workbooks is also left open after the save.
'
' Any existing .xls files in that path with names
' that will be created should be moved/deleted so that
' you are not plagued with "file exists, overwrite?"
' prompts.
'
Const newWBSavePath = "c:\temp\" ' must exist!
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer
Dim thisWB As Workbook
Dim newWB As Workbook
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
Set thisWB = ThisWorkbook
srcSheetName = thisWB.ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = thisWB.ActiveSheet.Range(ColAUsedAddress)
Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
thisWB.Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = thisWB.ActiveSheet.Range(anyAddressRange)
' add new WORKBOOK, it becomes active
Workbooks.Add
Set newWB = ActiveWorkbook
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
newWB.ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = newWB.ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = _
newWB.Worksheets(destSheetName).Range(anyAddressRa nge)
'copy to new sheet, column B
destRange.Value = srcRange.Value
'save the new workbook with an appropriate name
'and leave it open
newWB.SaveAs newWBSavePath & destSheetName & ".xls"
thisWB.Activate ' back to this workbook for another round
Set newWB = Nothing
Set destARange = Nothing
Set srcRange = Nothing
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub
Remove Rows with 0 (zero) Value
Sub kill_row()
Set rdel = Range("A65536")
For Each r In ActiveSheet.UsedRange
If Not IsEmpty(r) Then
If r.Value = 0 Then
Set rdel = Union(rdel, r)
End If
End If
Next
rdel.EntireRow.Delete
End Sub
Split into 10000 Rows

Sub testme()
Dim NewWks As Worksheet
Dim ActWks As Worksheet
Dim iRow As Long
Dim myStep As Long


Set ActWks = ActiveSheet
myStep = 10000
With ActWks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step
myStep
Set NewWks = Workbooks.Add(1).Worksheets(1)
.Rows(iRow).Resize(myStep).Copy _
Destination:=NewWks.Range("a1")
Next iRow
End With
End Sub

Rgds,
Dolphy