Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
The following code helps to copy to Visible Cells Only.
What I need is to select any one of the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
try this
Option Explicit Public StartWS As Worksheet Public CopyRng As Range Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWS = ActiveSheet Set CopyRng = Selection 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), _ "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long Dim Cell As Range Dim MyRow As Range Dim SourceRow As Long Dim SourceRows As Long Dim SourceCol As Long Dim SourceCols As Long Application.ScreenUpdating = False 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) SourceRows = CopyRng.Rows.Count SourceCols = CopyRng.columns.Count SourceRow = 1 SourceCol = 1 For Each MyRow In Target For Each Cell In MyRow.Cells If Cell.Visible = True Then StartWS.Cells(SourceRow, SourceCol).Copy _ Destination:=Cell 'increment to next cell If SourceCol = SourceCols Then SourceRow = SourceRow + 1 SourceCol = 1 Else SourceCol = SourceCol + 1 End If End If Next Cell Next MyRow Application.ScreenUpdating = True End Sub "Abdul" wrote: The following code helps to copy to Visible Cells Only. What I need is to select any one of the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Thanks..
I have tried this way of course a working solution I have .. I need to get this run through a userform.. On Aug 1, 6:04*pm, Joel wrote: try this Option Explicit Public StartWS As Worksheet Public CopyRng As Range Public Sub CopyToVisibleOnly1() * *'Start with cell selected that you want to copy. * *Set StartWS = ActiveSheet * *Set CopyRng = Selection * *'Call CopyToVisibleOnly2 after a five-second delay. * *Application.OnTime Now() + TimeValue("0:00:04"), _ * * * "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() * *'Declare local variables. * *Dim EndWB As Workbook, EndWS As Worksheet * *Dim Target As Range, CurrCell As Range * *Dim x As Long, FromCnt As Long * *Dim Cell As Range * *Dim MyRow As Range * *Dim SourceRow As Long * *Dim SourceRows As Long * *Dim SourceCol As Long * *Dim SourceCols As Long * *Application.ScreenUpdating = False * *'Select the range where it should be pasted. * *Set Target = Application.InputBox _ * * * (Prompt:="Select the first cell in the Paste range", Type:=8) * *SourceRows = CopyRng.Rows.Count * *SourceCols = CopyRng.columns.Count * *SourceRow = 1 * *SourceCol = 1 * *For Each MyRow In Target * * * For Each Cell In MyRow.Cells * * * * *If Cell.Visible = True Then * * * * * * StartWS.Cells(SourceRow, SourceCol).Copy _ * * * * * * * * * Destination:=Cell * * * * * * 'increment to next cell * * * * * * If SourceCol = SourceCols Then * * * * * * * *SourceRow = SourceRow + 1 * * * * * * * *SourceCol = 1 * * * * * * Else * * * * * * * *SourceCol = SourceCol + 1 * * * * * * End If * * * * *End If * * * Next Cell * *Next MyRow * *Application.ScreenUpdating = True End Sub "Abdul" wrote: The following code helps to copy to Visible Cells Only. What I need is to select any one of *the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
"Abdul" wrote: Thanks.. I have tried this way of course a working solution I have .. I need to get this run through a userform.. On Aug 1, 6:04 pm, Joel wrote: try this Option Explicit Public StartWS As Worksheet Public CopyRng As Range Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWS = ActiveSheet Set CopyRng = Selection 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), _ "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long Dim Cell As Range Dim MyRow As Range Dim SourceRow As Long Dim SourceRows As Long Dim SourceCol As Long Dim SourceCols As Long Application.ScreenUpdating = False 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) SourceRows = CopyRng.Rows.Count SourceCols = CopyRng.columns.Count SourceRow = 1 SourceCol = 1 For Each MyRow In Target For Each Cell In MyRow.Cells If Cell.Visible = True Then StartWS.Cells(SourceRow, SourceCol).Copy _ Destination:=Cell 'increment to next cell If SourceCol = SourceCols Then SourceRow = SourceRow + 1 SourceCol = 1 Else SourceCol = SourceCol + 1 End If End If Next Cell Next MyRow Application.ScreenUpdating = True End Sub "Abdul" wrote: The following code helps to copy to Visible Cells Only. What I need is to select any one of the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Why doesn't work with a userform? Are some cells protected? You may have
to create an array of the cells you want to Copy SourceArray = Array("A1","B2", "C3") or set SourceRange = Range("A1","B2","C3") "Abdul" wrote: Thanks.. I have tried this way of course a working solution I have .. I need to get this run through a userform.. On Aug 1, 6:04 pm, Joel wrote: try this Option Explicit Public StartWS As Worksheet Public CopyRng As Range Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWS = ActiveSheet Set CopyRng = Selection 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), _ "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long Dim Cell As Range Dim MyRow As Range Dim SourceRow As Long Dim SourceRows As Long Dim SourceCol As Long Dim SourceCols As Long Application.ScreenUpdating = False 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) SourceRows = CopyRng.Rows.Count SourceCols = CopyRng.columns.Count SourceRow = 1 SourceCol = 1 For Each MyRow In Target For Each Cell In MyRow.Cells If Cell.Visible = True Then StartWS.Cells(SourceRow, SourceCol).Copy _ Destination:=Cell 'increment to next cell If SourceCol = SourceCols Then SourceRow = SourceRow + 1 SourceCol = 1 Else SourceCol = SourceCol + 1 End If End If Next Cell Next MyRow Application.ScreenUpdating = True End Sub "Abdul" wrote: The following code helps to copy to Visible Cells Only. What I need is to select any one of the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
I think you code might be able to be made much simpler than what you are
using; but before I can know for sure, are your ranges *always* contiguous or do you allow for non-contiguous ranges as well? -- Rick (MVP - Excel) "Abdul" wrote in message ... The following code helps to copy to Visible Cells Only. What I need is to select any one of the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Thanks for all the effort and replys.. as I mentioned I have this
working solution. But does your answer related to my question? where is the user from involved here? I dont want to get a wait time for the user. The user will be selecting the worksheet and range (can be resttricted to one column) of his choice and the destination as well. Of course both source and destination may contain hidden which i want to avoid. Copying is simple but pasting is difficult. Thanks again On Aug 1, 7:20*pm, "Rick Rothstein" wrote: I think you code might be able to be made much simpler than what you are using; but before I can know for sure, are your ranges *always* contiguous or do you allow for non-contiguous ranges as well? -- Rick (MVP - Excel) "Abdul" wrote in message ... The following code helps to copy to Visible Cells Only. What I need is to select any one of *the open workbook using a combobox and select a range (visible Cells Only) using Refedit and copy the data and through same combobox and Refedit or another combobox and Refedit select the destination workbook and cell and paste the copied data to the visible cells only. Any Help Please.... Option Explicit Public StartWB As Workbook Public StartWS As Worksheet Public CopyRng As String Public Sub CopyToVisibleOnly1() 'Start with cell selected that you want to copy. Set StartWB = ActiveWorkbook Set StartWS = ActiveSheet CopyRng = Selection.Address 'Call CopyToVisibleOnly2 after a five-second delay. Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2" End Sub Private Sub CopyToVisibleOnly2() 'Declare local variables. Dim EndWB As Workbook, EndWS As Worksheet Dim Target As Range, CurrCell As Range Dim x As Long, FromCnt As Long On Error GoTo CTVOerr 'Select the range where it should be pasted. Set Target = Application.InputBox _ (Prompt:="Select the first cell in the Paste range", Type:=8) Set EndWB = ActiveWorkbook Set EndWS = ActiveSheet Set CurrCell = Target.Cells(1, 1) Application.ScreenUpdating = False 'Copy the cells from the original workbook, one at a time. StartWB.Activate StartWS.Activate For x = 1 To Range(CopyRng).Count StartWB.Activate StartWS.Activate Range(CopyRng).Cells(x, 1).Copy 'Return to the target workbook. EndWB.Activate EndWS.Activate CurrCell.Activate 'Only cells in visible rows in the selected 'range are pasted. Do While (CurrCell.EntireRow.Hidden = True) Or _ (CurrCell.EntireColumn.Hidden = True) Set CurrCell = CurrCell.Offset(1, 0) Loop CurrCell.Select ActiveSheet.Paste Set CurrCell = CurrCell.Offset(1, 0) Next x Cleanup: 'Free the object variables. Set Target = Nothing Set CurrCell = Nothing Set StartWB = Nothing Set StartWS = Nothing Set EndWB = Nothing Set EndWS = Nothing Application.ScreenUpdating = True Exit Sub CTVOerr: MsgBox Err.Description GoTo Cleanup End Sub |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Hello Abdul,
I posted put some code on a previous post of your relating to this but here is a modified version. It will run from a Userform but you should set the Userform ShowModal property to False. The code and userform can be in any workbook. It does not necessarily have to be in the Source data or Destination data workbook. It works for Hidden rows only. Have done nothing with hidden columns. You will have to edit the code to set the wbSource and wbDestin workbook variables. You might want to do this with additional code to be run prior to the InputBoxes but both the Source and Destination workbooks need to be open before the code gets to the Inputboxes. With the first InputBox simply select the full range to be copied. Does not matter if it appears to include hidden rows because the code will exclude hidden rows. With the second InputBox select the first visible cell only of the destination. The code will handle identifying the required visible cells for the paste. It pastes one row at a time. Private Sub CopyVisibleData_Click() Dim wbSource As Workbook Dim wbDestin As Workbook Dim rngSource As Range Dim rngDestin As Range Dim lngTotCols As Long Dim DestinOffset() Dim i As Long Dim j As Long Dim rngCel As Range 'NOTE: Code works from any workbook, 'or stand alone workbook. Set wbSource = Workbooks("Visible Cells Source.xls") Set wbDestin = Workbooks("Visible Cells Destin.xls") 'Must activate required workbook before 'InputBox code. wbSource.Activate On Error Resume Next Set rngSource = Application.InputBox _ (prompt:="Select Source Range to Copy", _ Title:="Source Selection", Type:=8) On Error GoTo 0 If rngSource Is Nothing Then MsgBox "User clicked Cancel." & vbCrLf & _ "Processing terminated." Exit Sub End If 'Save the total number of columns for Offset lngTotCols = rngSource.Columns.Count 'Alter selection to one column only and 'Exclude hidden cells from the selected range. 'Selecting one row only results in entire 'column to bottom of page being assigned 'to rngSource and hense the If/Else/End If. If rngSource.Rows.Count 1 Then Set rngSource = rngSource.Columns(1) _ .SpecialCells(xlCellTypeVisible) Else Set rngSource = rngSource.Cells(1, 1) End If 'Must activate required workbook before 'InputBox code. wbDestin.Activate DestinSelect: On Error Resume Next Set rngDestin = Application.InputBox _ (prompt:="Select destination workbook and worksheet" _ & vbCrLf & "Select FIRST cell only of destination", _ Title:="Destination Selection", Type:=8) On Error GoTo 0 If rngDestin Is Nothing Then MsgBox "User clicked Cancel." & vbCrLf & _ "Processing terminated." Exit Sub End If If rngDestin.Cells.Count < 1 Then MsgBox "Must select one visible cell only" GoTo DestinSelect End If 'Create array of destination offsets. ReDim DestinOffset(1 To rngSource.Cells.Count) i = 0 'Initialize j = 0 'Initialize Do If rngDestin.Offset(j) _ .EntireRow.Hidden = False Then i = i + 1 DestinOffset(i) = j End If j = j + 1 Loop While i < UBound(DestinOffset) 'Copy and paste the rows from source 'to the destination. i = 0 'Initialize For Each rngCel In rngSource i = i + 1 Range(rngCel, rngCel.Offset _ (0, lngTotCols - 1)).Copy _ Destination:=rngDestin _ .Offset(DestinOffset(i)) Next rngCel End Sub -- Regards, OssieMac |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Thanks Ossie,
As I have mentioned earlier I cant hard code the source or destination workbook. can you give me an example code where the user select the open workbook through a ComboBox and the range through a RefEdit and user select the destination workbook through a ComboBox and a Destination Cell throug a RefEdit This is the part I am stuck with. Thanks again for your effort... , On Aug 2, 12:06*pm, OssieMac wrote: Hello Abdul, I posted put some code on a previous post of your relating to this but here is a modified version. It will run from a Userform but you should set the Userform ShowModal property to False. The code and userform can be in any workbook. It does not necessarily have to be in the Source data or Destination data workbook. It works for Hidden rows only. Have done nothing with hidden columns. You will have to edit the code to set the wbSource and wbDestin workbook variables. You might want to do this with additional code to be run prior to the InputBoxes but both the Source and Destination workbooks need to be open before the code gets to the Inputboxes. With the first InputBox simply select the full range to be copied. Does not matter if it appears to include hidden rows because the code will exclude hidden rows. With the second InputBox select the first visible cell only of the destination. The code will handle identifying the required visible cells for the paste. It pastes one row at a time. Private Sub CopyVisibleData_Click() Dim wbSource As Workbook Dim wbDestin As Workbook Dim rngSource As Range Dim rngDestin As Range Dim lngTotCols As Long Dim DestinOffset() Dim i As Long Dim j As Long Dim rngCel As Range 'NOTE: Code works from any workbook, 'or stand alone workbook. Set wbSource = Workbooks("Visible Cells Source.xls") Set wbDestin = Workbooks("Visible Cells Destin.xls") 'Must activate required workbook before 'InputBox code. wbSource.Activate On Error Resume Next Set rngSource = Application.InputBox _ * * (prompt:="Select Source Range to Copy", _ * * Title:="Source Selection", Type:=8) On Error GoTo 0 If rngSource Is Nothing Then * * MsgBox "User clicked Cancel." & vbCrLf & _ * * * * * * "Processing terminated." * * * * * * Exit Sub End If 'Save the total number of columns for Offset lngTotCols = rngSource.Columns.Count 'Alter selection to one column only and 'Exclude hidden cells from the selected range. 'Selecting one row only results in entire 'column to bottom of page being assigned 'to rngSource and hense the If/Else/End If. If rngSource.Rows.Count 1 Then * * Set rngSource = rngSource.Columns(1) _ * * * * .SpecialCells(xlCellTypeVisible) Else * * Set rngSource = rngSource.Cells(1, 1) End If 'Must activate required workbook before 'InputBox code. wbDestin.Activate DestinSelect: On Error Resume Next Set rngDestin = Application.InputBox _ * * (prompt:="Select destination workbook and worksheet" _ * * & vbCrLf & "Select FIRST cell only of destination", _ * * Title:="Destination Selection", Type:=8) On Error GoTo 0 If rngDestin Is Nothing Then * * MsgBox "User clicked Cancel." & vbCrLf & _ * * * * * * "Processing terminated." * * * * * * Exit Sub End If If rngDestin.Cells.Count < 1 Then * * MsgBox "Must select one visible cell only" * * GoTo DestinSelect End If 'Create array of destination offsets. ReDim DestinOffset(1 To rngSource.Cells.Count) i = 0 * 'Initialize j = 0 * 'Initialize Do * * If rngDestin.Offset(j) _ * * * * .EntireRow.Hidden = False Then * * * * * * i = i + 1 * * * * * * DestinOffset(i) = j * * End If * * j = j + 1 Loop While i < UBound(DestinOffset) 'Copy and paste the rows from source 'to the destination. i = 0 'Initialize For Each rngCel In rngSource * * i = i + 1 * * Range(rngCel, rngCel.Offset _ * * * * (0, lngTotCols - 1)).Copy _ * * * * Destination:=rngDestin _ * * * * .Offset(DestinOffset(i)) Next rngCel End Sub -- Regards, OssieMac |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy to Visible Cells only;Modify Code
Hellow again Abdul,
Now I think I understand the problem better. Previously I thought that it just was not working in conjunction with the Userform and that you knew how to code the Userform part. However, a couple of questions first because I am not sure how much code you really need. Have you already populated the workbook names in the ComboBox lists (for both Source and Destination)? If you haven't done the above, is that what you also need help with? If so, I need some information regarding a file filter like "Source*.xls" and "Destination*.xls" so the correct files can be gathered for the lists. Does the path have to be selected or can it be hard coded? (If hard coded then I can mark that in the code for you to edit.) If you have not already populated the workbook names in the ComboBox list and you need the user to select both path and file name then perhaps I can suggest using the Workbook Open dialog box and use a command button to invoke it. The user can then select both the path and file name in the one operation. Let me know your decision. Do you want to be able to make all the selections on the form and then have a separate command button to process it. Obviously the workbooks need to be opened in the afterupdate event of the comboboxes so that the RefEdit selections can be made. I prefer a button to execute the copy/paste code after the selections are made because it gives the user a chance to review the selections and make changes if necessary. Will wait to hear from you. -- Regards, OssieMac |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy Visible Cells in Sheet with Merged and Hidden Cells | Excel Discussion (Misc queries) | |||
Copy Visible Cells and paste in another workbook visible cells only | Excel Programming | |||
copy visible cells | Excel Worksheet Functions | |||
Copy visible cells only | Excel Programming | |||
Copy visible cells only | Excel Discussion (Misc queries) |