Macro is copy row and paste row based on user input

webbooo

New Member
Joined
Nov 8, 2011
Messages
19
Hello,

I currently have a macro that I recorded that basically copies row 15 and the inserts the copied row to row 18.
While this works ok, over time the number of rows will increase as such that row 15 will be a row that shouldnt be copied.
I'd like to like to look at having a macro that prompts the user which row number should be copied and then prompts for which row number it should be inserted into.

Any help would be appreciated.

Thanks
Adam
 
If I try to run the previous macro, I get the attached error
 

Attachments

  • Screenshot 2023-03-25 110439.jpg
    Screenshot 2023-03-25 110439.jpg
    10.7 KB · Views: 2
Upvote 0

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
To use the macro in post #17 :
• For the first input box, select the required rows on the source sheet and click OK.
• For the second input box, go to Sheet1, select the required row and click OK.

To use the macro in post #19:
• For the first input box, select the required rows on the source sheet and click OK.
• For the second input box, select the required destination row on the source sheet and click OK. The rows per the first input box will be inserted on Sheet1 at the row selected in the second input box.

If you want to type the destination row (instead of selecting) into the second input box :
VBA Code:
Sub v()
Dim c As Range, d, a As Range
On Error Resume Next
Set c = Application.InputBox("Select the row(s) to be copied.", Type:=8)
d = Application.InputBox("Enter the row number where to insert.", Type:=1)
On Error GoTo 0
If c Is Nothing Then
    MsgBox "The source rows were not selected"
    Exit Sub
ElseIf TypeName(d) = "Boolean" Then
    MsgBox "The destination row was not entered"
    Exit Sub
End If
For Each a In c.Areas
    a.EntireRow.Copy
    Sheets("Sheet1").Rows(Val(d)).EntireRow.Insert
Next
Application.CutCopyMode = False
End Sub
 
Upvote 1
To use the macro in post #17 :
• For the first input box, select the required rows on the source sheet and click OK.
• For the second input box, go to Sheet1, select the required row and click OK.

To use the macro in post #19:
• For the first input box, select the required rows on the source sheet and click OK.
• For the second input box, select the required destination row on the source sheet and click OK. The rows per the first input box will be inserted on Sheet1 at the row selected in the second input box.

If you want to type the destination row (instead of selecting) into the second input box :
VBA Code:
Sub v()
Dim c As Range, d, a As Range
On Error Resume Next
Set c = Application.InputBox("Select the row(s) to be copied.", Type:=8)
d = Application.InputBox("Enter the row number where to insert.", Type:=1)
On Error GoTo 0
If c Is Nothing Then
    MsgBox "The source rows were not selected"
    Exit Sub
ElseIf TypeName(d) = "Boolean" Then
    MsgBox "The destination row was not entered"
    Exit Sub
End If
For Each a In c.Areas
    a.EntireRow.Copy
    Sheets("Sheet1").Rows(Val(d)).EntireRow.Insert
Next
Application.CutCopyMode = False
End Sub
Sorry - me again! Is there any way to amend this code that even when selecting a range eg $4:$7 that it will ignore any hidden rows?
 
Upvote 0
The code I'm currently using is below -

Sub ExportAsCSV()

Dim MyFileName As String
Dim Item As String
Dim Path As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim myrangeNA As Range
Dim myRangeCSV As Range
Path = "D:\xxx"

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("CSV").Activate
Set myrangeNA = Application.InputBox(prompt:="Select a range to copy (include header row).", Type:=8)
Item = InputBox("Please input filename", "Filename")

Set TempWB = Application.Workbooks.Add(1)
myrangeNA.Copy Destination:=TempWB.Worksheets("Sheet1").Range("A1")

MyFileName = Path & "\" & Item & ".csv"

Application.DisplayAlerts = True
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Try the following (untested).
VBA Code:
Sub ExportAsCSV()

Dim MyFileName As String
Dim Item As String
Dim Path As String
'Dim CurrentWB As Workbook
Dim TempWB As Workbook
Dim myrangeNA As Range
Dim a As Range
'Dim myRangeCSV As Range
Path = "D:\xxx"

'Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("CSV").Activate
Set myrangeNA = Application.InputBox(prompt:="Select a range to copy (include header row).", Type:=8)
Set myrangeNA = myrangeNA.SpecialCells(xlCellTypeVisible)

Item = InputBox("Please input filename", "Filename")

Set TempWB = Application.Workbooks.Add
For Each a In myrangeNA.Areas
    a.Copy Destination:=TempWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(3)(2)
Next

MyFileName = Path & "\" & Item & ".csv"

'Application.DisplayAlerts = True
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
'Application.DisplayAlerts = True
End Sub
 
Upvote 0
Try the following (untested).
VBA Code:
Sub ExportAsCSV()

Dim MyFileName As String
Dim Item As String
Dim Path As String
'Dim CurrentWB As Workbook
Dim TempWB As Workbook
Dim myrangeNA As Range
Dim a As Range
'Dim myRangeCSV As Range
Path = "D:\xxx"

'Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("CSV").Activate
Set myrangeNA = Application.InputBox(prompt:="Select a range to copy (include header row).", Type:=8)
Set myrangeNA = myrangeNA.SpecialCells(xlCellTypeVisible)

Item = InputBox("Please input filename", "Filename")

Set TempWB = Application.Workbooks.Add
For Each a In myrangeNA.Areas
    a.Copy Destination:=TempWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(3)(2)
Next

MyFileName = Path & "\" & Item & ".csv"

'Application.DisplayAlerts = True
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
'Application.DisplayAlerts = True
End Sub
Unfortunately not quite - when it gets to a hidden column it then copies the next section of columns underneath rather than continuing along.
 

Attachments

  • Screenshot 2023-07-01 111457.jpg
    Screenshot 2023-07-01 111457.jpg
    116.9 KB · Views: 2
Upvote 0
I was working on the basis of hidden rows only.
Do you have hidden columns only or also some hidden rows?
 
Upvote 0
I was working on the basis of hidden rows only.
Do you have hidden columns only or also some hidden rows?
Sorry, that was my typo - meant columns initially, not rows! I have now managed to work out a workaround for what I need, but thank you for your help!
 
Upvote 0

Forum statistics

Threads
1,215,043
Messages
6,122,822
Members
449,096
Latest member
Erald

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top