Macro is copy row and paste row based on user input

[webbooo]

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

 

[billy1989]

You do not have to reference the sheet in the input box - go to Sheet1 and make the selection.
Or if you prefer to select on the active sheet :

Sub v()
Dim c As Range, d As Range, a As Range
On Error Resume Next
Set c = Application.InputBox("Select the row(s) to be copied.", Type:=8)
Set d = Application.InputBox("Select the row where to insert.", Type:=8)
On Error GoTo 0
If c Is Nothing Then
    MsgBox "The source rows were not selected"
    Exit Sub
ElseIf d Is Nothing Then
    MsgBox "The destination row was not selected"
    Exit Sub
End If
For Each a In c.Areas
    a.EntireRow.Copy
    Sheets("Sheet1").Rows(d.Row).EntireRow.Insert
Next
Application.CutCopyMode = False
End Sub

Sorry, what I'm looking for is for to be able to run the macro from a button on one sheet, to select the rows, but for these rows to insert by default onto Sheet1 at a row number I specify (eg as in images)

 

[billy1989]

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

 

[billy1989]

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 :

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?

 

[billy1989]

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

 

[footoo]

Try the following (untested).

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

 

[billy1989]

Try the following (untested).

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.

 

[footoo]

I was working on the basis of hidden rows only.
Do you have hidden columns only or also some hidden rows?

 

[billy1989]

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!