E
el dee
Hi,
I know the 1004 error common and a problem, but I can't seem to get around
this one. I have used this code before and it worked great. I have denoted
the function on the bottom for debug....
Thanks!!
Const Maxrow = 50000
Sub Headers_To_Macro_Test()
' Headers_To_Macro_Test Macro
' Macro recorded 9/9/2009 by
Dim wksCopy As Worksheet
Dim wksPaste As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
With ThisWorkbook
Set wksCopy = .Worksheets("Summary")
Set wksPaste = .Worksheets("All_Data_Headers")
End With
Set rngCopy = SetCopyRange(wksCopy, "B5:C5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "A:B")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "B6:C6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "C")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E5:F5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "E:F")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "H5:I5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "K:L")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E6:F6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "G:H")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E7:F7")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "I:J")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "H6:I6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "M:N")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "B9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "O")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "D9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "P")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "G9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "Q")
rngCopy.Copy rngPaste
End Sub
Function SetCopyRange(Wks As Worksheet, strAddress As String) As Range
Set SetCopyRange = Wks.Range(strAddress)
End Function
Function SetPasteRangeByColumn(Wks As Worksheet, strColumn As String) As Range
Dim lngRow As Long
lngRow = Wks.Rows.Count
**Set SetPasteRangeByColumn = Worksheets("All_Data_Headers").Cells(lngRow,
strColumn).End(xlUp).Offset(1, 0)--**Application defined or object-defined
ERROR
End Function
I know the 1004 error common and a problem, but I can't seem to get around
this one. I have used this code before and it worked great. I have denoted
the function on the bottom for debug....
Thanks!!
Const Maxrow = 50000
Sub Headers_To_Macro_Test()
' Headers_To_Macro_Test Macro
' Macro recorded 9/9/2009 by
Dim wksCopy As Worksheet
Dim wksPaste As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
With ThisWorkbook
Set wksCopy = .Worksheets("Summary")
Set wksPaste = .Worksheets("All_Data_Headers")
End With
Set rngCopy = SetCopyRange(wksCopy, "B5:C5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "A:B")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "B6:C6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "C")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E5:F5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "E:F")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "H5:I5")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "K:L")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E6:F6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "G:H")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "E7:F7")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "I:J")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "H6:I6")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "M:N")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "B9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "O")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "D9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "P")
rngCopy.Copy rngPaste
Set rngCopy = SetCopyRange(wksCopy, "G9")
Set rngPaste = SetPasteRangeByColumn(wksPaste, "Q")
rngCopy.Copy rngPaste
End Sub
Function SetCopyRange(Wks As Worksheet, strAddress As String) As Range
Set SetCopyRange = Wks.Range(strAddress)
End Function
Function SetPasteRangeByColumn(Wks As Worksheet, strColumn As String) As Range
Dim lngRow As Long
lngRow = Wks.Rows.Count
**Set SetPasteRangeByColumn = Worksheets("All_Data_Headers").Cells(lngRow,
strColumn).End(xlUp).Offset(1, 0)--**Application defined or object-defined
ERROR
End Function