PDA

View Full Version : export a range



lior03
12-15-2005, 12:35 AM
hello
i have a list whitch i can selewct from through a macro values that meet a certain criteria like all names with a four character names (????).
all those value turn red. i want to copy them to anothewr sheet and paste them
there.
what wrong with rhe macro i have
Sub copyselect()
Dim cell As Range
Dim newsheet As Worksheet
For Each cell In selection
If cell.Font.ColorIndex = 3 Then
cell.Copy
Set newsheet = Worksheets.Add
newsheet.Range("A1").PasteSpecial paste:=xlValues
End If
Next
End Sub
thanks

lior03
12-15-2005, 04:29 AM
hello
this is another more elaborate version of the macro.i can not make the macro paste the result i got (all cell turn red) into another sheet.
please help
thanks
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

mdmackillop
12-15-2005, 06:08 AM
Hi Moshe,
Could you please edit your post to use the VBA tags around your code. It makes it more readable.
Regards
MD

lior03
12-15-2005, 06:10 AM
hello
how do i edite my tags
thanks

lior03
12-15-2005, 06:13 AM
hello
this is another more elaborate version of the macro.i can not make the macro paste the result i got (all cell turn red) into another sheet.
please help
thanks
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

lior03
12-15-2005, 06:14 AM
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

lior03
12-15-2005, 06:18 AM
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").Activate
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

johnske
12-15-2005, 09:02 AM
hello
how do i edite my tags
thanksClick the VBA tags link in my signature below...

lior03
12-15-2005, 11:10 AM
like that?hello
this is another more elaborate version of the macro.i can not make the macro paste the result i got (all cell turn red) into another sheet.
please help
thanks
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

lior03
12-15-2005, 11:12 AM
hello
this is another more elaborate version of the macro.i can not make the macro paste the result i got (all cell turn red) into another sheet.
please help
thanks

Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

lior03
12-15-2005, 11:15 AM
hello
this is another more elaborate version of the macro.i can not make the macro paste the result i got (all cell turn red) into another sheet.
please help
thanks
Sub likeit2()
Range(selection, selection.End(xlDown)).Select
selection.clearformats
Cells.HorizontalAlignment = xlRight
Application.ScreenUpdating = False
Dim cell As Range
Dim x As String
Dim newsheet As Worksheet
x = InputBox("select text format,do not use inverted commas:", "text finder", Default:="enter data like ???")
If x = Empty Then Exit Sub
For Each cell In selection
If cell Like x Then
cell.Font.ColorIndex = 3
cell.Copy
Set newsheet = Worksheets.Add
Range("A1").PasteSpecial xlPasteValues
selection.Font.Bold = True
If Not cell Like x Then
selection.Font.Bold = True
Exit Sub
Application.ScreenUpdating = True
End If
End If
Next
End Sub

geekgirlau
12-15-2005, 08:31 PM
Personally I find it quicker to have a reference formula that you can use to filter the results. For example, if your conditional formatting is highlight cells with a value <100, then you can have a formula like

=IF(C2<100,"Copy","")

You can then record a macro that uses the autofilter to select all rows where the filter formula = "Copy", and copy those rows in one hit to a new sheet.

lior03
12-26-2007, 12:16 AM
hello
i am trying to export a range that meet a certain criteria - date's quarter number to a new sheet.

On Error Resume Next
Dim cell As Range
Dim qtr As Integer
Dim qr As Integer
If IsEmpty(selection) Then Exit Sub
qtr = InputBox("select quarter number: 1 to 4", "select:")
For Each cell In selection
qr = DatePart("q", cell)
If qr = qtr Then
cell.Copy
Sheets.Add
ActiveSheet.paste
End If
Next


how do i make the sheet open once ,with all dates that meet the criteria.

mikerickson
12-26-2007, 07:18 AM
Your code is adding new sheet for every cell that meets your criteria. If you want one new sheet with all the matching values.



Dim newSheet as Worksheet
Rem code

Set newSheet = Sheets.Add
For Each cell In selection
qr = DatePart("q", cell)
If qr = qtr Then
newSheet.Range("A65536").End(xlup).Offset(1,0).Value=Cell.Value
End If
Next
newSheet.Range("A1").Delete Shift:=xlup
If newSheet.Range("A1").Value = vbNullString then newSheet.Delete
Application.ScreenUpdating = True

lior03
12-26-2007, 10:01 PM
hello
the code failed to copy the dates.why?
thanks

mikerickson
12-27-2007, 09:23 PM
Does it copy anything?

lior03
12-28-2007, 01:30 PM
no.as far as i understand the problem is with my add sheet command.how can i place it outside the loop and still make the macro select dates?
thanks