View Single Post
  #6   Report Post  
JIM.H.
 
Posts: n/a
Default

Hi JMB,
Thanks for your help it works fine. I have one more problem. How can I
change copy-paste in a way that links and formulas be broken, I just want to
see values. However the Format should still be copied.
Thanks,


"JMB" wrote:

I'm assuming you only want columns A & B through whatever row you selected in
column C,D,E,F.......

Of course, you can change the filename under SaveAs to save the files to a
specific folder. I just used whatever folder contains the original file.
Just replace "Thisworkbook.Path & Application.PathSeparator" with whatever
other folder you need (such as "C:\Temp").



Sub CopyData()
Dim SelectedRange As Range
Dim CopyRange As Range

Set SelectedRange = Selection
Application.Calculation = xlCalculationManual

For Each x In SelectedRange
Set CopyRange = Union(Range(Cells(1, 1), Cells(x.Row, 2)), _
Range(Cells(1, x.Column), _
Cells(x.Row, x.Column)))

CopyRange.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False

With ActiveWorkbook.ActiveSheet
.Cells.Columns.AutoFit
With .PageSetup
.RightHeader = "&D &T"
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
.Zoom = False
End With
End With

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & _
Application.PathSeparator & _
ThisWorkbook.ActiveSheet.Cells(1, x.Column).Value
Application.DisplayAlerts = True
ActiveWorkbook.Close
Next x

Application.Calculation = xlCalculationAutomatic
End Sub


"JIM.H." wrote:

Hello JMB,
This is really good, working fine.
How can I create a loop for this code?
A) Loop until selected row has no data in it (so D18, E18, F18, €¦)
B) Save to the file with the following:
1. Get the file name from D1 (or E1, F1, €¦)
2. overwriting
3. doing columns fit
4. doing page setup as fit to, and portrait
5. put current date/time header

Thanks,


"JMB" wrote:

In my last post I assumed A1:B18 would always be constant. If you want
columns A-B only through the row number you select (in column C or D or
whatever) you'll need to change

Set CopyRange = Union(Range("A1:B18"), _
Range(Cells(1, ActiveCell.Column), _
Cells(ActiveCell.Row, ActiveCell.Column)))

To

Set CopyRange = Union(Range(cells(1,1),cells(activecell.row,2)), _
Range(Cells(1, ActiveCell.Column), _
Cells(ActiveCell.Row, ActiveCell.Column)))


"JIM.H." wrote:

Hello,
I am trying to copy-paste a part of an excel file based on the selected cell
and create another excel file and save it. Here is the scenario:

1. I clicked E18 (this is an example, it can be D18 or others) and run the
macro
2. Macro should select E1-E18 (if D18, then D1-D18) and A1-B18 (so first two
columns and selected column up to the row the cell selected)
3. copy selected area
4. Create a file test.xls
5. paste it into first cell (I assume this will combine all three columns
together, so the data will be in A.B and C columns, not in A,B and E (or D))
6. save file

How can I do this?
Thanks,
Jim.