CODEWITHSUNDEEP
vbaexcel
Arun Palanisamy
Arun Palanisamy

Reputation: 5459

Copy rows starting from certain row till the end using macro

I need to copy values of one excel and create a new one with required format. Say i need to copy columns from B11 to BG11 and rows will be till the end.( i don't know how to find the end of rows). And I have column heading in b7 to bg7. In between there are unwanted rows and i don't need it. So in the new excel i want column headings(which is from b7 to bg7) as first row and the values from b11 to bg11 till the end.

This is my first excel Macro. I don't know how to proceed. So with references from some stackoverflow question and other site, i have tried the below code. but it is not giving the required output.

Sub newFormat()

Dim LastRow As Integer, i As Integer, erow As Integer

LastRow = ActiveSheet.Range(“B” & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

Sheets("MySheetName").Range("B7:BG7").Copy
Sheets("MySheetName").Range("B11:BG11").Copy


Workbooks.Open Filename:=”C:\Users\abcd\Documents\Newformat.xlsx”
Worksheets(“Sheet1”).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i
End Sub

this may be simple. any help would be appreciated.

Upvotes: 2

Views: 5371

Answers (2)

Siddharth Rout
Siddharth Rout

Reputation: 149295

Few things...

  1. Do not use Integer for rows. Post xl2007, the number of rows have increased and Integer can't hold that. Use Long

  2. You do not need to select a range to paste on it. You can directly perform the action.

  3. You do not need to use a loop. You can copy ranges in two chunks

  4. Work with objects so Excel doesn't get confused by your objects.

  5. Since Sheet1 is empty, you don't need to find the last row there. Simply start at 1.

  6. To output the data to new workbook, you have to use Workbooks.Add

See this example (Untested)

Sub newFormat()
    Dim wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    Dim LastRow As Long, erow As Long

    '~~> Set this to the relevant worksheet
    Set wsI = ThisWorkbook.Sheets("HW SI Upload")
    '~~> Find the last row in Col B
    LastRow = wsI.Range("B" & wsI.Rows.Count).End(xlUp).Row

    '~~> Open a new workbook
    Set wbO = Workbooks.Add
    '~~> Set this to the relevant worksheet
    Set wsO = wbO.Sheets(1)

    '~~> The first row in Col A for writing
    erow = 1
    '~~> Copy Header
    wsI.Range("B7:BG7").Copy wsO.Range("A" & erow)

    '~~> Increment output row by 1
    erow = erow + 1

    '~~> Copy all rows from 11 to last row
    wsI.Range("B11:BG" & LastRow).Copy wsO.Range("A" & erow)

    '~~> Clear Clipboard
    Application.CutCopyMode = False

    '
    '~~> Code here to do a Save As
    '
End Sub

Upvotes: 4

Davesexcel
Davesexcel

Reputation: 6984

Different but the same

Rename the sheet

Sub Button1_Click()
    Dim wb As Workbook, ws As Worksheet, sh As Worksheet
    Dim LstRw As Long, Rng As Range, Hrng As Range

    Set sh = Sheets("MySheetName")

    With sh
        Set Hrng = .Range("B7:BG7")
        LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set Rng = .Range("B11:BG" & LstRw)
    End With

    Application.ScreenUpdating = 0

    Workbooks.Open Filename:="C:\Users\abcd\Documents\Newformat.xlsx"

    Set wb = Workbooks("Newformat.xlsx")
    Set ws = wb.Sheets(1)

    Hrng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    Rng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    ws.Name = sh.Name    'renames sheet
    wb.Save
    wb.Close

End Sub

Upvotes: 1

Related Questions