Copy & Paste Using Defined Name Ranges

[bloodmilksky]

Hi Guys,

I was just wondering if anyone knows how I can adjust the below code so it will

• Copy Cells B21 & C21 On sheet 1
• To A Range Defined in B7
• The range is on sheet 2 and is the users name

Sub CopySheet1A1toSheet2NextCellInColumnA() Dim LastRowSheet2 As Long LastRowSheet2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row Sheets("Sheet2").Cells(LastRowSheet2 - [Sheet2!A1<>""], "A").Value = [Sheet1!A1]End Sub

please any help would be greatly appreciated

many thanks

jamie

 

[bloodmilksky]

Hi

So you copy B21:C21 To a destination determined in B7(named range). but instead of this would it be possible to COPY B1:C1 to A destination determined in A1. but do it for the whole column intead of a single value so B1:C1 would go to range determined in A1 And B2:C2 would go to destination determined in A2 and so on.

 

[gallen]

Try this:

Sub CopySheet1A1toSheet2NextCellInColumnA()

Dim lRow As Long, l As Long
Dim sRangeName As String
Dim lLastRow As Long 'Last used row in Column A on Sheet1


    'Last Used Row
    lLastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    'Loop through all used cells on column A with a value
    For l = 1 To lLastRow
        'Copy Cells B & C of the current row On sheet 1
        Sheets("Sheet1").Range("B" & l & ":C" & l).Copy
        'get the name range
        sRangeName = Sheets("Sheet1").Range("A" & l).Value
        'replace any spaces with underscore:
        sRangeName = Replace(sRangeName, " ", "_")
        
        'get next empty row in named range
        lRow = 1
        With Sheets("Sheet2").Range(sRangeName).Cells(lRow, 1)
            Do Until .Value = ""
                lRow = lRow + 1
            Loop
            'Paste Data
            .PasteSpecial xlPasteAll
        End With
        
    Next l

End Sub

 

[bloodmilksky]

Hi it keeps saying object not defined on sheet 2 1004 error. but I have checked everything is in place and I dont know if I am missing something

Try this:

Sub CopySheet1A1toSheet2NextCellInColumnA()

Dim lRow As Long, l As Long
Dim sRangeName As String
Dim lLastRow As Long 'Last used row in Column A on Sheet1


    'Last Used Row
    lLastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    'Loop through all used cells on column A with a value
    For l = 1 To lLastRow
        'Copy Cells B & C of the current row On sheet 1
        Sheets("Sheet1").Range("B" & l & ":C" & l).Copy
        'get the name range
        sRangeName = Sheets("Sheet1").Range("A" & l).Value
        'replace any spaces with underscore:
        sRangeName = Replace(sRangeName, " ", "_")
        
        'get next empty row in named range
        lRow = 1
        [B][U]With Sheets("Sheet2").Range(sRangeName).Cells(lRow, 1)[/U][/B]
            Do Until .Value = ""
                lRow = lRow + 1
            Loop
            'Paste Data
            .PasteSpecial xlPasteAll
        End With
        
    Next l

End Sub

 

[gallen]

Have you checked the value in sRangeName? is it correct and is the range named correctly?

 

[bloodmilksky]

would it be okay to email you the work book

 

[gallen]

First thing I've noticed is that you've changed part of the code. Of course this wont work because it is always on row 2:

This is the code you have in your workbook:

Sub CopySheet1A1toSheet2NextCellInColumnA()

Dim lRow As Long, l As Long
Dim sRangeName As String
Dim lLastRow As Long 'Last used row in Column A on Sheet1

    'Last Used Row
    lLastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    'Loop through all used cells on column A with a value
    For l = 1 To lLastRow
        'Copy Cells B & C of the current row On sheet 1
        [COLOR=#ff0000][B]Sheets("Sheet1").Range("B" & 2 & ":C" & 2).Copy[/B][/COLOR]
        'get the name range
        [B][COLOR=#ff0000]sRangeName = Sheets("Sheet1").Range("A" & 2).Value[/COLOR][/B]
        'replace any spaces with underscore:
        sRangeName = Replace(sRangeName, " ", "_")
        
        'get next empty row in named range
        lRow = 1
        With Sheets("Sheet2").Range(sRangeName).Cells(lRow, 1)
        Do Until .Value = ""
            lRow = lRow + 1
        Loop
        'Paste Data
        .PasteSpecial xlPasteAll
        End With
    
    Next l

End Sub

This code is not what I gave you. I've spent so much time on this, I need a little help from you! I've worked out you were trying to get it to START at line 2 but you changed the completely wrong part

I'm also confused with the spreadsheet. It wasn't anything like I expected. I thought Column A had names of ranges with spaces in them instead they all have something like:

AlastairWadeOptometrists123109003

Earlier in the thread you asked to replace spaces with underscore. I added these lines:

    sRangeName = Sheets("Sheet1").Range("B7").Value
    'replace any spaces with underscore:
    sRangeName = Replace(sRangeName, " ", "_")

How does the above have any effect? There is just numbers is sheet1(B7) and the most currrent code uses a named range in A1 which has zero spaces.

===========================================================

There are many entries in column A with illegal characters. No way could the code you have requested work on this sheet. There are brackets, square brackets and slashes. Please tidy the sheet up.

I've done all I can with your sheet. Here is code that would work with correctly formatted data. There is no more I can do:

Sub CopySheet1A1toSheet2NextCellInColumnA()

Dim lRow As Long, l As Long
Dim sRangeName As String
Dim lLastRow As Long 'Last used row in Column A on Sheet1

    'Last Used Row
    lLastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    'Loop through all used cells on column A with a value
    For l = 2 To lLastRow 'Changed to 2


        'get the name range
        sRangeName = Sheets("Sheet1").Range("A" & l).Value
        'replace any spaces with underscore:
        sRangeName = Replace(sRangeName, " ", "_")
        
        'get next empty row in named range
        lRow = 1
        
        Do Until Sheets("Sheet2").Range(sRangeName).Cells(lRow, 1).Value = ""
            lRow = lRow + 1
        Loop
        'Copy Cells B & C of the current row On sheet 1
        Sheets("Sheet1").Range("B" & l & ":C" & l).Copy
        'Paste Data
        Sheets("Sheet2").Range(sRangeName).Cells(lRow, 1).PasteSpecial xlPasteAll
        
    Next l

End Sub

 

[bloodmilksky]

Hi Gallen,

My apologies For the state of the spreadsheet I sent over to you. But I didn’t want to put all of the query’s into one post and as I am still learning I want to try and do as much as I can.

· The Final Sheet will have a macro that runs through column A and clears all of the random values and then concatenates the Business name and AC together.
· Once this is done the first macro will run through sheet 1 column a, b & c and create named ranges on sheet 2.
· Then it will sort through columns D & E into the named ranges
· Then finally these ranges will be emailed off to the accounts on sheet 2.

My apologies again for any trouble I have caused you I truly didn’t meant to at all

Jamie

 

[gallen]

I've just had a look. I've created the sub that automatically generates the named ranges. I have no clue what criteria determines where the values in columns D and E will go.

You may need to start another thread because I can not spend any more time on this. Very sorry. I will send you what I have written so far.