Cannot copy to the last cell in the range

[Jadvanianil]

I have written a code to loop though range of cells and copy certain data in a column. But everytime I run the code it just copies the last record and not all of them. The issue is somewhere in the destination line of code where it can't find the last unused cell. Any help will be very appreciated. Many Thanks.

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">[COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#303336][FONT=inherit] ImmoScout[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] MyRange [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Mycell [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Mycell2 [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Set[/FONT][/COLOR][COLOR=#303336][FONT=inherit] MyRange [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Application[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Selection
    [/FONT][/COLOR][COLOR=#858C93][FONT=inherit]'Application.ScreenUpdating = False[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]For[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Each[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Mycell [/FONT][/COLOR][COLOR=#101094][FONT=inherit]In[/FONT][/COLOR][COLOR=#303336][FONT=inherit] MyRange
        Mycell2 [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Mycell[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Value
        Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Sheet1"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Activate
        Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Sheet1"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]AutoFilterMode [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]False[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"A1:BB34470"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]AutoFilter Field[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]54[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Criteria1[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Mycell2
        Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"AM1"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Select[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlDown[/FONT][/COLOR][COLOR=#303336][FONT=inherit])).[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Select[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
            [/FONT][/COLOR][COLOR=#101094][FONT=inherit]If[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Cells[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Count [/FONT][/COLOR][COLOR=#303336][FONT=inherit]<[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1048576[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Then[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
                Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Copy Destination[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"BP1048576"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlUp[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Offset[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]0[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
                Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"AU1"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Activate
                Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlDown[/FONT][/COLOR][COLOR=#303336][FONT=inherit])).[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Select[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
                Selection[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Copy Destination[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Range[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"BQ1048576"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]xlUp[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Offset[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]0[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
            [/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#101094][FONT=inherit]If[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Next[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Mycell
   [/FONT][/COLOR][COLOR=#858C93][FONT=inherit]' Application.ScreenUpdating = True[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
[/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR]</code>

 

[njimack]

It's hard to tell what you're code is attempting to do, but the below should be far more efficient

Sub ImmoScout()
    Dim Mycell As Range
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    
    For Each Mycell In Selection
        
        With Sheets("Sheet1")
            .AutoFilterMode = False
            .Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell
            LastRow = .Cells(Rows.Count, 39).End(xlUp).row
            If LastRow > 1 Then
                Range(.Cells(1, 39), .Cells(LastRow, 39)).Copy .Cells(Rows.Count, 68).End(xlUp).Offset(1)
                Range(.Cells(1, 40), .Cells(LastRow, 39)).Copy .Cells(Rows.Count, 69).End(xlUp).Offset(1)
             End If
        End With
    Next Mycell
    Application.ScreenUpdating = True
End Sub

 

[Jadvanianil]

Hi, thank you very much for making the code more efficient and readable, and simple to understand too I have tried this and its still giving me the same output as the earlier code. So there are 12 cells in the selection. The first part loops through them one by one and the latter part copies the filtered data in the destination. i dont understand why it only copied the filtered data for 12th cell and not the first 11.

 

[njimack]

I think it's because the column you're using to determine the last row isn't the column where the data is being pasted, so it gets overwritten each time. To be sure, what happens when you step through the code using F8? (after commenting out the ScreenUpdating line)

 

[Jadvanianil]

I have just made some small column changes to your code as below. So I am using column 39 to determine if the filtered data has any records (>1 as top row is the title). And if it has then copy that and paste all cells from col 39 into col 68. And from col 47 into col 69. I did use f8 and ran through the code but everytime it is just overwritting my previous pasted data in col 68 and 69. This is very strange as the code runs perfectly fine.
Sub ImmoScoutCheck()
Dim Mycell As Range
Dim LastRow As Long

Application.ScreenUpdating = False

For Each Mycell In Selection

With Sheets("Sheet1")
.AutoFilterMode = False
.Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell
LastRow = .Cells(Rows.Count, 39).End(xlUp).Row
If LastRow > 1 Then
Range(.Cells(1, 39), .Cells(LastRow, 39)).Copy .Cells(Rows.Count, 68).End(xlUp).Offset(1)
Range(.Cells(1, 47), .Cells(LastRow, 47)).Copy .Cells(Rows.Count, 69).End(xlUp).Offset(1)
End If
End With
Next Mycell
Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

It's hard to tell what you're code is attempting to do, but the below should be far more efficient

Sub ImmoScout()
    Dim Mycell As Range
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    
    For Each Mycell In Selection
        
        With Sheets("Sheet1")
            .AutoFilterMode = False
            .Range("A1:BB34470").AutoFilter Field:=54, Criteria1:=Mycell
            LastRow = .Cells(Rows.Count, 39).End(xlUp).row
            If LastRow > 1 Then
                [B][COLOR="#FF0000"]Range(.Cells(1, 39), .Cells(LastRow, 39)).Copy .Cells(Rows.Count, 68).End(xlUp).Offset(1)[/COLOR][/B]
                [B][COLOR="#FF0000"]Range(.Cells(1, 40), .Cells(LastRow, [/COLOR][COLOR="#0000FF"]39[/COLOR][COLOR="#FF0000"])).Copy .Cells(Rows.Count, 69).End(xlUp).Offset(1)[/COLOR][/B]
             End If
        End With
    Next Mycell
    Application.ScreenUpdating = True
End Sub

It appears that nothing changes in the two lines I highlighted in red above. That would mean that with each iteration of the loop, those two lines copy the exact same ranges to the exact same locations over and over again. Also, should the 39 that I highlighted in blue actually be 40 instead?

 

[Jadvanianil]

Hi, i have made the changes to the range as below
Range(.Cells(1, 39), .Cells(LastRow, 39)).Copy .Cells(Rows.Count, 68).End(xlUp).Offset(1)
Range(.Cells(1, 47), .Cells(LastRow, 47)).Copy .Cells(Rows.Count, 69).End(xlUp).Offset(1)
But its still the same output. Dont understand why its overwriting on already pasted data in col68 and 69

 

[Jadvanianil]

Hi, I have shared a link to have a better view of my file below,
dropbox.com/s/tvrq1v9gt20q581/IS24_Jun17_base.xlsx?dl=0