ExcelBanter - Q: how can I write this macro?

ExcelBanter (https://www.excelbanter.com/)

- Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)

- - Q: how can I write this macro? (https://www.excelbanter.com/excel-discussion-misc-queries/28380-q-how-can-i-write-macro.html)

Q: how can I write this macro?

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.

This should work.

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

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

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Test.xls"
ActiveWorkbook.Close

End Sub

"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.

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.

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.

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.

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.

Try changing the paste commands to PasteSpecial as follows

CopyRange.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False

You could also make it run faster and lessen the eyestrain by turning off
the ScreenUpdating. Just put the following lines in the macro at the
beginning and end (immediately before or after the lines that turn on/off the
calculation).

Application.ScreenUpdating = False
Application.ScreenUpdating = True

"JIM.H." wrote:

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.