Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Column A
Hello,
I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Column A
Hi ScottMSP
Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
Hi Ron,
The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#4
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
Hi Scott
Yes, you copy all columns(full rows) to column B so that will not fit You must change the range to Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast) This copy column A to Z -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#5
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
Hi Ron,
Thanks so much. Worked like a charm. I had a feeling it had something to do with pasting a whole row, but my knowledge of VBA is very limited and so when I tried to tweak, I could not find the right sequence to make it work. Do you have any recommendations of books that might be useful for an advanced Excel user who is learning to write Macros to get the basics/foundational in how to write macros to do this type of programming? Thanks again. "Ron de Bruin" wrote: Hi Scott Yes, you copy all columns(full rows) to column B so that will not fit You must change the range to Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast) This copy column A to Z -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#6
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
Hi Scott
Nice gift for Christmas http://www.amazon.com/gp/product/0764540726 Or the 2007 version http://www.amazon.com/gp/product/0470044012 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, Thanks so much. Worked like a charm. I had a feeling it had something to do with pasting a whole row, but my knowledge of VBA is very limited and so when I tried to tweak, I could not find the right sequence to make it work. Do you have any recommendations of books that might be useful for an advanced Excel user who is learning to write Macros to get the basics/foundational in how to write macros to do this type of programming? Thanks again. "Ron de Bruin" wrote: Hi Scott Yes, you copy all columns(full rows) to column B so that will not fit You must change the range to Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast) This copy column A to Z -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#7
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
Thanks Ron,
Looks excellent and just right for me. You are the best! -Scott "Ron de Bruin" wrote: Hi Scott Nice gift for Christmas http://www.amazon.com/gp/product/0764540726 Or the 2007 version http://www.amazon.com/gp/product/0470044012 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, Thanks so much. Worked like a charm. I had a feeling it had something to do with pasting a whole row, but my knowledge of VBA is very limited and so when I tried to tweak, I could not find the right sequence to make it work. Do you have any recommendations of books that might be useful for an advanced Excel user who is learning to write Macros to get the basics/foundational in how to write macros to do this type of programming? Thanks again. "Ron de Bruin" wrote: Hi Scott Yes, you copy all columns(full rows) to column B so that will not fit You must change the range to Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast) This copy column A to Z -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#8
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Ron DeBruin Macro - Moving Sheet Name from Last Column to Colu
You are welcome
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Thanks Ron, Looks excellent and just right for me. You are the best! -Scott "Ron de Bruin" wrote: Hi Scott Nice gift for Christmas http://www.amazon.com/gp/product/0764540726 Or the 2007 version http://www.amazon.com/gp/product/0470044012 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, Thanks so much. Worked like a charm. I had a feeling it had something to do with pasting a whole row, but my knowledge of VBA is very limited and so when I tried to tweak, I could not find the right sequence to make it work. Do you have any recommendations of books that might be useful for an advanced Excel user who is learning to write Macros to get the basics/foundational in how to write macros to do this type of programming? Thanks again. "Ron de Bruin" wrote: Hi Scott Yes, you copy all columns(full rows) to column B so that will not fit You must change the range to Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast) This copy column A to Z -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hi Ron, The macro stopped running/failed at the .PasteSpecial XlPasteValues line. Thoughts? -Scott CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With "Ron de Bruin" wrote: Hi ScottMSP Use this CopyRng.Copy With DestSh.Cells(Last + 1, "B") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the A column DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ScottMSP" wrote in message ... Hello, I have a follow-up question Ron DeBruin's Macro that merge's worksheets. I want to be have the sheet name go in column A instead of the last column after the data. I have tried to tweak this a few different ways, but either it overwrites the data in column A or the Macro fails. I suspect this a simple tweak. Thanks to all who respond. Sub CopyDataWithoutHeaders_v2() 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'Fill in the start row StartRow = 48 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Visible = True Then 'Copy header row, change the range if you use more columns If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then sh.Range("A2:AH2").Copy DestSh.Range("A1") End If 'Find the last row with data on the DestSh and sh Last = Lastrow(DestSh) shLast = Lastrow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng 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 if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "AI").Resize(CopyRng.Rows.Count).Value = sh.Name End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Moving to Column A using a macro | Excel Discussion (Misc queries) | |||
Move Column within Sheet with VB Macro | Excel Discussion (Misc queries) | |||
Moving data in one excel column to another sheet based on user input | Excel Discussion (Misc queries) | |||
Why is my tab key moving my cursor from column A to column k? | Excel Discussion (Misc queries) | |||
moving the formula "average" over one column in a macro | Excel Worksheet Functions |