why cant i copy the last row?

gkhidhir

New Member
Joined
Jun 17, 2015
Messages
11
For w = 1 To LastRowHere(6)
LastRowThere(6) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(6)).End(xlUp).Row
For s = LastRowThere(6) To LastRowThere(6)
here.Sheets("Sheet1").Rows(w).Columns(source(0)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(0))
here.Sheets("Sheet1").Rows(w).Columns(source(1)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(1))
here.Sheets("Sheet1").Rows(w).Columns(source(2)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(2))
here.Sheets("Sheet1").Rows(w).Columns(source(3)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(3))
here.Sheets("Sheet1").Rows(w).Columns(source(4)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(4))
here.Sheets("Sheet1").Rows(w).Columns(source(5)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(5))
here.Sheets("Sheet1").Rows(w).Columns(source(6)).Copy Destination:=there.Sheets("Sheet1").Rows(s + 1).Columns(log(6))
Columns(log(6)).WrapText = True
Columns(log(6)).AutoFit
Columns(log(6)).ColumnWidth = 30
Next s
Next w
my copy file has 9 rows with data. my destination file has 8 rows with data that the macro copied over.

anyone know why i cant copy the last row?
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi gkhidir, please post code in between code tags (see example below in red) or use MrExelHTML as I have done here.

I have shortened and optimised your code a bit and noticed (unless it is a typo) that the 'For s=' loop only runs once. is that the intention? see the comments. Or should it be
Code:
 For s = LastrowHere(6) to LastrowThere(6)

<font face=Calibri>    <SPAN style="color:#00007F">Dim</SPAN> wsHere <SPAN style="color:#00007F">As</SPAN> Worksheet, wsThere <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, w <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wsThere = there.Sheets("Sheet1")<br>    <SPAN style="color:#00007F">For</SPAN> w = 1 <SPAN style="color:#00007F">To</SPAN> LastRowHere(6)<br>        <SPAN style="color:#00007F">Set</SPAN> wsHere = here.Sheets("Sheet1")<br>        LastRowThere(6) = wsThere.Cells(Sheets("Sheet1").Rows.Count, Log(6)).End(xlUp).Row<br>        <SPAN style="color:#00007F">For</SPAN> s = LastRowThere(6) <SPAN style="color:#00007F">To</SPAN> LastRowThere(6) <SPAN style="color:#007F00">'??? is this correct? It will only run once <<<<<</SPAN><br>            <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> 6<br>                <SPAN style="color:#007F00">' don't use copy n paste, just set the values to what you want. Much quicker</SPAN><br>                wsther.Cells(s + 1, Log(i)).Value = wsHere.Cells(w, Source(i)).Value<br>            <SPAN style="color:#00007F">Next</SPAN> i<br>        <SPAN style="color:#00007F">Next</SPAN> s<br>    <SPAN style="color:#00007F">Next</SPAN> w<br>    <SPAN style="color:#007F00">' don't do the formatting inside the loop, waste of time</SPAN><br>    Columns(Log(6)).WrapText = <SPAN style="color:#00007F">True</SPAN><br>    Columns(Log(6)).AutoFit<br>    Columns(Log(6)).ColumnWidth = 30<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wsHere = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsThere = <SPAN style="color:#00007F">Nothing</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0
Code after trying to find solution
Code:
Code:
Sub ConWarrCopyOver()

Dim here As Workbook
Dim there As Workbook
Set here = Workbooks.Open("C:\Documents and Settings\Khidhim\My Documents\FSRmacro.xlsm")
Set there = Workbooks.Open("C:\Documents and Settings\Khidhim\My Documents\Setting3.xlsm")


Dim source(7) As String
Dim log(6) As String


Dim LastRowHere As Integer
Dim LastRowThere(6) As Integer


'source are for the columns in FSR
'not a fixed value as program is supposedly made to be compatible for a few different source with different format 
source(0) = ThisWorkbook.Sheets("Sheet1").Range("E11").Value
source(1) = ThisWorkbook.Sheets("Sheet1").Range("E12").Value
source(2) = ThisWorkbook.Sheets("Sheet1").Range("E13").Value
source(3) = ThisWorkbook.Sheets("Sheet1").Range("E14").Value
source(4) = ThisWorkbook.Sheets("Sheet1").Range("E15").Value
source(5) = ThisWorkbook.Sheets("Sheet1").Range("E16").Value
source(6) = ThisWorkbook.Sheets("Sheet1").Range("E17").Value
'Next array is for Coverage Tab
source(7) = ThisWorkbook.Sheets("Sheet1").Range("E18").Value


'log are for the columns in the complaint log
log(0) = ThisWorkbook.Sheets("Sheet1").Range("J11").Value
log(1) = ThisWorkbook.Sheets("Sheet1").Range("J12").Value
log(2) = ThisWorkbook.Sheets("Sheet1").Range("J13").Value
log(3) = ThisWorkbook.Sheets("Sheet1").Range("J14").Value
log(4) = ThisWorkbook.Sheets("Sheet1").Range("J15").Value
log(5) = ThisWorkbook.Sheets("Sheet1").Range("J16").Value
log(6) = ThisWorkbook.Sheets("Sheet1").Range("J17").Value




'Next variable is for Coverage Tab last row
LastRowHere = here.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, source(7)).End(xlUp).Row




'Stop screen from updating to speed things up
Application.ScreenUpdating = False


'start from second row because first row is for all the column headings
For A = 2 To LastRowHere

    ' For the last rows in each columns
    LastRowThere(0) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(0)).End(xlUp).Row
    LastRowThere(1) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(1)).End(xlUp).Row
    LastRowThere(2) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(2)).End(xlUp).Row
    LastRowThere(3) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(3)).End(xlUp).Row
    LastRowThere(4) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(4)).End(xlUp).Row
    LastRowThere(5) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(5)).End(xlUp).Row
    LastRowThere(6) = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(6)).End(xlUp).Row

    ' To check if the row of data, from source(7) column contains "CONT" or "WARR", if yes copy all the data specifically chosen column in that row of data.
    If here.Sheets("Sheet1").Cells(A, source(7)).Value = "CONT" Or here.Sheets("Sheet1").Cells(A, source(7)).Value = "WARR" Then
    
    here.Sheets("Sheet1").Cells(A, source(0)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(0) + 1, log(0))
    here.Sheets("Sheet1").Cells(A, source(1)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(1) + 1, log(1))
    here.Sheets("Sheet1").Cells(A, source(2)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(2) + 1, log(2))
    here.Sheets("Sheet1").Cells(A, source(3)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(3) + 1, log(3))
    here.Sheets("Sheet1").Cells(A, source(4)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(4) + 1, log(4))
    here.Sheets("Sheet1").Cells(A, source(5)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(5) + 1, log(5))
    here.Sheets("Sheet1").Cells(A, source(6)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere(6) + 1, log(6))
'can add later
    'Rows(A).RowHeight = 25
    'Columns(log(1)).AutoFit
    'Columns(log(2)).WrapText = True
    
    End If
    
Next A


End Sub

The purpose of the code is to check the if a row of data has "CONT" or "WARR" from a column, if yes copy specifically chosen columns data in that row from first excel worksheet to another another worksheet with specifically chosen column. The program works but its not copying empty cells and will shift the data up. Can anybody help me with this issue?

Will be changing the copy paste to set values.
 
Upvote 0
On a copy of your workbook as totally untested and just out of interest what does the code below give you?

Rich (BB code):
Sub ConWarrCopyOver()

    Dim here As Workbook
    Dim there As Workbook
    Set here = Workbooks.Open("C:\Documents and Settings\Khidhim\My Documents\FSRmacro.xlsm")
    Set there = Workbooks.Open("C:\Documents and Settings\Khidhim\My Documents\Setting3.xlsm")


    Dim source(7) As String
    Dim log(6) As String


    Dim LastRowHere As Long
    Dim LastRowThere As Long


    'source are for the columns in FSR
    'not a fixed value as program is supposedly made to be compatible for a few different source with different format
    source(0) = ThisWorkbook.Sheets("Sheet1").Range("E11").Value
    source(1) = ThisWorkbook.Sheets("Sheet1").Range("E12").Value
    source(2) = ThisWorkbook.Sheets("Sheet1").Range("E13").Value
    source(3) = ThisWorkbook.Sheets("Sheet1").Range("E14").Value
    source(4) = ThisWorkbook.Sheets("Sheet1").Range("E15").Value
    source(5) = ThisWorkbook.Sheets("Sheet1").Range("E16").Value
    source(6) = ThisWorkbook.Sheets("Sheet1").Range("E17").Value
    'Next array is for Coverage Tab
    source(7) = ThisWorkbook.Sheets("Sheet1").Range("E18").Value


    'log are for the columns in the complaint log
    log(0) = ThisWorkbook.Sheets("Sheet1").Range("J11").Value
    log(1) = ThisWorkbook.Sheets("Sheet1").Range("J12").Value
    log(2) = ThisWorkbook.Sheets("Sheet1").Range("J13").Value
    log(3) = ThisWorkbook.Sheets("Sheet1").Range("J14").Value
    log(4) = ThisWorkbook.Sheets("Sheet1").Range("J15").Value
    log(5) = ThisWorkbook.Sheets("Sheet1").Range("J16").Value
    log(6) = ThisWorkbook.Sheets("Sheet1").Range("J17").Value




    'Next variable is for Coverage Tab last row
    LastRowHere = here.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, source(7)).End(xlUp).Row




    'Stop screen from updating to speed things up
    Application.ScreenUpdating = False


    'start from second row because first row is for all the column headings
    LastRowThere = there.Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, log(0)).End(xlUp).Row + 1
    For A = 2 To LastRowHere

        ' To check if the row of data, from source(7) column contains "CONT" or "WARR", if yes copy all the data specifically chosen column in that row of data.
        If here.Sheets("Sheet1").Cells(A, source(7)).Value = "CONT" Or here.Sheets("Sheet1").Cells(A, source(7)).Value = "WARR" Then

            here.Sheets("Sheet1").Cells(A, source(0)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(0))
            here.Sheets("Sheet1").Cells(A, source(1)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(1))
            here.Sheets("Sheet1").Cells(A, source(2)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(2))
            here.Sheets("Sheet1").Cells(A, source(3)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(3))
            here.Sheets("Sheet1").Cells(A, source(4)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(4))
            here.Sheets("Sheet1").Cells(A, source(5)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(5))
            here.Sheets("Sheet1").Cells(A, source(6)).Copy Destination:=there.Sheets("Sheet1").Cells(LastRowThere, log(6))

            LastRowThere = LastRowThere + 1
            'can add later
            'Rows(A).RowHeight = 25
            'Columns(log(1)).AutoFit
            'Columns(log(2)).WrapText = True

        End If

    Next A


End Sub
 
Upvote 0
The code basically does a 'filter' of the data from the source, take required data of the filtered data and copy it over to another excel worksheet.
 
Upvote 0
Are you describing what your code done or results you got after testing the code I posted?
 
Upvote 0

Forum statistics

Threads
1,214,591
Messages
6,120,431
Members
448,961
Latest member
nzskater

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