Copy rows from one sheet to another sheet whose name is given by the user.

H

harzer

Board Regular
Joined
Dec 15, 2021
Messages
159
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,
Given my low level in vba, I allow myself to post my request for code that I cannot solve, presenting my thanks in advance to all those who from far or near can contribute to advancing my request.

The requested code should copy the lines selected by the user in the "Issues" sheet to paste them in the sheet of his choice. Which means that asking the user for the name of the sheet is necessary, the "Issues" sheet contains 11 columns and important and variable rows each month. I have reduced the number of lines for the purposes of this request.

Information: To save time when you want to select the rows to copy, we will only select a single cell for each row concerned but not the entire row.

The code put in place must take into account two scenarios:

First case: The name of the sheet mentioned by the user does not exist, so it must be created, taking care to put the same headers as the "Issues" sheet in the first line and only then copy the selected lines .

Second case: The sheet exists, then we have two possibilities:

The user is then asked if he wishes to keep the old existing data, if the answer is "yes", in this case, we go to the first empty line below the existing lines to copy the new data there.

If the user does not wish to keep the old data, in this case, we erase the existing data from the 2nd line to the last line and then only after we paste the new lines selected from the second line, since the first line already contains the same headers as the "Issues" sheet.

Important information: the selected rows are not always next to each other, sometimes they are and sometimes they are not.

I hope I was clear in my explanations to allow you to help me solve my problem, however, I remain at your disposal for other additional information.

Here is the content of the "Issues" sheet

Classeur1.xlsm
ABCDEFGHIJK
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevage
2856-022/2011 M0811-021/2008 M435-007/2009 FAE --> CF10a 0m 0j1B7380934TFemelle x
3876-025/2006 F0811-021/2008 M435-007/2009 FAE --> CF10a 0m 0j1B7388224TFemelle x
4
5876-054/2004 F0811-021/2008 M856-047/2002 FAE --> CF10a 10m 10j1B8388224TFemelle x
6
7AE-003/2011 M235-096/2005 M856-078/2010 FAE --> CF10a 10m 10j1H8391874TFemelle x
8
9AE-014/2011 M25-004/2009 M856-117/2009 FAE --> CF10a 10m 10j1H8391874TFemelle x
10
11AE-015/2011 F838-010/2008 M856-146/2009 FAE --> CF10a 10m 15j1H10402574TFemelle x
12AE-035/2013 F838-010/2008 M856-146/2009 FAT10a 10m 15j1H12402834TFemelle x
13AE-035R/2012 F838-010/2008 M856-146/2009 FAT10a 10m 15j1H12402834TFemelle x
14AE-036/2013 M838-010/2008 M856-146/2009 FAT10a 10m 15j1H12402834TFemelle x
15
16AE-037/2013 M856-004/2010 M856-146/2009 FAT10a 10m 18j2B12402834TFemelle x
17
18AE-039/2012 M856-061/2002 M856-186/2007 FAT10a 10m 18j2B12402834TFemelle x
19
20AE-040/2012 F856-093/2010 M876-027/2005 FAT10a 11m 24j2B12402834TFemelle x
21
22AE-041/2012 F856-093/2010 M876-053/2009 FDB10a 11m 24j2B12402834TFemelle x
23
24AE-042/2012 F856-111/2010 M876-053/2009 FDB10a 11m 24j2B12402834TFemelle x
25AE-042R-12/2013 F856-111/2010 M876-053/2009 FDB10a 11m 24j2B12402834TFemelle x
26
27AE-046/2012 M856-111/2010 MAE-044/2011 FEA10a 11m 24j2B12402834TFemelle x
28
29AE-047/2012 F856-111/2010 MAE-056/2012 FEA10a 11m 24j2B12402844TFemelle x
30AE-048/2012 F856-111/2010 MAE-056/2012 FEA11a 0m 1j2B12402844TFemelle x
31AE-049/2012 M856-111/2010 MAE-056/2012 FEA11a 0m 1j2B17402844TFemelle x
32AE-050/2012 M856-111/2010 MAE-056/2012 FEA11a 0m 1j2H17406334TFemelle x
33AE-051/2012 M856-111/2010 MAE-056/2012 FEA11a 0m 29j3H17406374TFemelle x
34AE-052/2012 M856-111/2010 MAE-056/2012 FEA11a 0m 2j3H17406484TFemelle x
35
36AE-053/2012 F856-115/2009 MAE-060/2010 FEA11a 0m 2j3H17406484TFemelle x
37
38AE-067/2012 M856-117/2009 MAE-062/2010 FEA11a 0m 2j4B17406484TFemelle x
39
40AE-083R-12/2013 F856-117/2009 MAE-133/2010 FEA11a 0m 2j4B17406484TFemelle x
41
42AE-091/2011 M856-117/2009 MAE-140/2011 FEA11a 0m 2j4B17406484TFemelle x
43AE-092/2011 M856-117/2009 MAE-140/2011 FEA12a 0m 11j4B17406484TFemelle x
44AT-064/2010 M856-117/2009 MAE-140/2011 FEA12a 0m 17j4B17406484TFemelle x
45AT-066/2010 F856-117/2009 MAE-140/2011 FEA12a 0m 17j4B30406484TFemelle x
46
47AT-067/2010 F876-037/2009 MAE-140/2011 FEA12a 0m 18j4B30406484TFemelle x
48AT-126/2012 M876-037/2009 MAE-140/2011 FEA12a 0m 18j4B30406484TFemelle x
49
50AT-128/2011 F876-037/2009 MAT-123/2011 FEA12a 0m 18j4B30406494TFemelle x
51
52AT-150/2012 F876-049/2009 MAT-136/2011 FEA12a 0m 18j4B30406494TFemelle x
53CF*-131/2012 M876-049/2009 MAT-136/2011 FEA12a 0m 18j4B30406554TFemelle x
54
55CF*-132/2012 M876-050/2009 MAT-136/2011 FEA12a 0m 18j4B30410034TFemelle
56
57CF*-133/2012 FAC10-008/2010 MAT-136/2011 FEA12a 0m 18j4B30410305TFemelle
58
59CF*-134/2012 FAE-014/2011 MMM-034/2011 FEA12a 0m 18j4B30410305TFemelle
60CF*-135/2012 MAE-014/2011 MMM-034/2011 FEA12a 0m 18j4B30410305TMâle
61CF*-136/2012 FAE-014/2011 MMM-034/2011 FEA12a 0m 18j4B30410305TMâle
62HCH57-018/2010 FAE-014/2011 MMM-034/2011 FMM12a 0m 29j4B30410305TMâle
63
64HCH57-019/2010 FHCH55-027/2011 MMM-034/2011 FMM12a 1m 3j4B30410315TMâle
65
66MM-009/2011 FMA-009/2009 MMM-034/2011 FMM13a 0m 17j4B30410315TMâle
67MM-013/2011 MMA-009/2009 MMM-034/2011 FMM13a 0m 17j4B30410315TMâle
68
69MM-020/2011 MMA-017/2008 MMM-034/2011 FMM13a 0m 17j4B30410385TMâle
70MM-047/2010 FMA-017/2008 MMM-034/2011 FMM13a 0m 18j4H30410385TMâle
71
72MM-048/2010 MMM-020/2011 MMM-034/2011 FMM13a 0m 18j4H30410385TMâle
73
74PG-004/2011 MMM-020/2011 MMM-047/2010 FMY13a 0m 18j4H30410385TMâle
75
76PG-009/2011 MMM-020/2011 MPG-005/2004 FPG13a 0m 18j4H30410385TMâle
77
78PG-024/2011 MMM-020/2011 MPG-012/2008 FPG13a 0m 18j4H30410385TMâle
79PG-025/2011 FMM-020/2011 MPG-012/2008 FPG13a 0m 18j5B30410755TMâle
80PG-026/2011 FMM-020/2011 MPG-012/2008 FPG13a 0m 18j5B30410755TMâle
81PG-028/2006 FMM-020/2011 MPG-012/2008 FPG13a 0m 18j5H30410785TMâle
82PG-038/2012 FMM-020/2011 MPG-012/2008 FPG13a 0m 18j5H30410785TMâle
83PG-039/2010 MMM-020/2011 MPG-012/2008 FPG13a 0m 18j5H30410785TMâle
84
85PG-041/2010 FMM-020/2011 MPG-017/2009 FPG13a 1m 13j5H30410785TMâle
86
87PG-041/2012 FPG-009/2011 MPG-017/2009 FPG16a 0m 18j5H30410835TMâle
88PG-042/2012 MPG-009/2011 MPG-017/2009 FPG16a 0m 18j5H30410835TMâle
89
90PG-044/2010 FPG-024/2011 MPG-019/2006 FPG17a 0m 18j5H30410835TMâle
91
92PG-045/2010 FPG-039/2010 MPG-019/2006 FPG17a 0m 18j5H30413975TMâle
93
94PG-051/2010 FPG-039/2010 MPG-024/2009 FPG19a 0m 17j5H30413975TMâle
95PG-066/2010 FPG-039/2010 MPG-024/2009 FPG9a 10m 19j5H30413985TMâle
96
97PG-067/2007 FPG-068/2006 MPG-076/2009 FPG9a 10m 23j5H30414125TMâle
98PG-068/2007 FPG-068/2006 MPG-076/2009 FPG9a 11m 15j5H30414355TMâle
99
100SC57-018/2010 FPG-075/2010 MPG-076/2009 FPG9a 11m 29j5H30414395TMâle
Issus
 
Last edited:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Try this macro:
VBA Code: 
Public Sub Copy_Selected_Issues()

    Dim userSelection As Range
    Dim sheetName As String
    Dim destCell As Range
    Dim destSheet As Worksheet
    Dim reply As Variant
    
    Set userSelection = Selection

    sheetName = InputBox("Enter name of destination sheet")
    If sheetName = "" Then Exit Sub
    
    Set destSheet = Nothing
    On Error Resume Next
    Set destSheet = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0
    
    If destSheet Is Nothing Then
        'Destination sheet doesn't exist - add new sheet
        With ThisWorkbook
            Set destSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        End With
        destSheet.Name = sheetName
        Set destCell = destSheet.Range("A1")
    Else
        'Destination sheet exists
        reply = MsgBox("'" & destSheet.Name & "' sheet already exists.  Clear existing data?", vbInformation + vbYesNoCancel)
        If reply = vbYes Then
            destSheet.Cells.Clear
            Set destCell = destSheet.Range("A1")
        ElseIf reply = vbNo Then
            Set destCell = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp)
            If destCell.Row > 1 Then Set destCell = destCell.Offset(1)
        ElseIf reply = vbCancel Then
            Exit Sub
        End If
    End If
        
    'Copy row(s) of user selection to destination sheet
    
    If destCell.Row = 1 Then
        userSelection.Worksheet.Rows(1).Copy destCell   'copy Issues headers row
        userSelection.EntireRow.Copy destCell.Offset(1)
    Else
        userSelection.EntireRow.Copy destCell
    End If
    
    'Apply column widths from Issues sheet to destination sheet
    
    userSelection.Worksheet.Columns("A:K").Copy
    destSheet.Select
    destSheet.Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
End Sub
 
Upvote 0
Hello John_w,
Thank you very much for your proposal.
I tested your code, it works well and I am totally satisfied.
I take this opportunity to ask you for additional coding, hoping that it can be done without too many complications, otherwise, we leave the code as it is now.
I felt the need and added this additional code only by testing your code, here is what it is:
How can we avoid copying an already existing row in the destination sheet?
With thanks.
 
Upvote 0
harzer said:
How can we avoid copying an already existing row in the destination sheet?
Click to expand...

The easiest and fastest way is to copy existing rows and remove duplicates. Simply add this after copying the rows:

VBA Code: 
    'Remove duplicates
    
    destSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), Header:=xlYes
 
Upvote 0
Hello John_w,
Thank you for your message and the update to avoid duplicates.
Everything works well. Best regard.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Grouping rows with the same values into columns "B" and "C"
Replies
5
Views
590
harzer
H
H
  • Solved
Modify content of cells in column "F" according to the content of cells in column "A"
Replies
5
Views
520
igold
igold
H
  • Solved
Count nonblank lines (between blank lines)
2
Replies
15
Views
1K
Alex Blakenburg
A
H
  • Question Question
copy some columns based on the value in column "A".
Replies
9
Views
365
Cubist
Cubist
H
  • Solved
Copy rows if cells in column "K" end with either "X" or "x".
Replies
3
Views
235
rollis13
rollis13

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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