Copying Columns

[ankrups]

Hi,

I have scenario below for copying columns data and pasting into seperate tab within file.

What I want is, copy columns from E3 to J to last row of data that mentioned and copy into "Record Allocation" worksheet within file.

At the same time, when ever this macro runs every time it should keep copy of last block and copy the next available blank row.

Please advise how to make this happen.

Please reply if you want more info.

Thanks.

 

[Rick Rothstein]

Hi,

I have scenario below for copying columns data and pasting into seperate tab within file.

What I want is, copy columns from E3 to J to last row of data that mentioned and copy into "Record Allocation" worksheet within file.

At the same time, when ever this macro runs every time it should keep copy of last block and copy the next available blank row.

Give this macro a try...

Sub CopyColumnsEthruJ()
  Dim LastRowEJ As Long, LastRowRA As Long
  LastRowEJ = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  On Error Resume Next
  LastRowRA = Sheets("Record Allocation").Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  On Error GoTo 0
  Range("E3:J" & LastRowEJ).Copy Sheets("Record Allocation").Cells(LastRowRA + 1, "A")
End Sub

 

[ankrups]

Thanks you for your quick reply. Only problem that I found is that I forgot to mentioned to paste as value on destination worksheet which is "Record Allocation".

Rest working fine.

Can you please send me amended code?

thank you very much.

 

[Rick Rothstein]

Thanks you for your quick reply. Only problem that I found is that I forgot to mentioned to paste as value on destination worksheet which is "Record Allocation".

Rest working fine.

Can you please send me amended code?

This should do it for you...

Sub CopyColumnsEthruJ()
  Dim LastRowEJ As Long, LastRowRA As Long
  LastRowEJ = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  On Error Resume Next
  LastRowRA = Sheets("Record Allocation").Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  On Error GoTo 0
  Sheets("Record Allocation").Cells(LastRowRA + 1, "A").Resize(LastRowEJ - 3, 6) = Range("E3:J" & LastRowEJ).Value
End Sub

 

[ankrups]

Thank you very much. It works.

 

[Max_Excel]

Hi Rick,

Don't know if I should post this as a new thread or not. But need your help urgently.

I got the below code from this forum and is almost perfect for me, but can you make this code run for data based on the headers? I have a spreadsheet which have headers from Col A to AM and I want paste data from only few columns to my main sheet. Please note data is to be pasted on the next empty row.

Data should be pasted from test sheet to the master sheet in next empty row but as per the column headers. Sequence of the headers may change.

Private Sub Open_File_Click()Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim SourceRange As Range
Dim FileToOpen As Variant


    Set wb1 = ActiveWorkbook
    Set PasteStart = wb1.Worksheets("Sheet2").Range("A1")




    FileToOpen = Application.GetOpenFilename


    If FileToOpen = False Then
        MsgBox "No Report Selected", vbExclamation, "ERROR"
        Exit Sub
    Else
        Set wb2 = Workbooks.Open(Filename:=FileToOpen)


        For Each Sheet In wb2.Sheets
            Set SourceRange = Sheet.UsedRange.Offset(1)
            SourceRange.Copy
            Set PasteStart = wb1.Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            PasteStart.PasteSpecial Paste:=xlPasteAll
        Next Sheet


    End If


    wb2.Close



End Sub