• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

vba to copy range of rows with variable number

Range(Worksheets("Breaking_Data").Range("M5:R5"), Worksheets("Breaking_Data").Range("M5:R5").End(xlDown)).Copy

I use this line of code for copy data range, this code work good if data range more then 2 rows, if data range have 1 row then its give error. so i need to re-write this line to copy data range however its contain 1 row or number of row. More if possible make this code short for best result.

Code:
Private Sub breakMyList_Click()

' This macro takes values in the range myList
' and breaks it in to multiple lists
' and saves them to separate files.

Dim cell As Range
Dim curPath As String
Dim IstCust As Range
Dim MyL As Range

Dim ws As Worksheet, WB As Workbook
Set WB = ActiveWorkbook
Set ws = WB.Sheets("Invoice")

Worksheets("Breaking_Data").Activate
Set MyL = Worksheets("Breaking_Data").Range("B4", Range("I1048576").End(xlUp))

curPath = ActiveWorkbook.Path & "\"

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each cell In Range("K5", Range("K1048576").End(xlUp))

    Worksheets("Breaking_Data").Range("B2") = cell.Value
    [MyL].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Worksheets("Breaking_Data").Range("B1:I2"), CopyToRange:=Worksheets("Breaking_Data").Range("M4:R4"), Unique:=False

ws.Copy After:=Sheets(WB.Sheets.Count)
ActiveSheet.Name = Worksheets("Breaking_Data").Range("B2").Value
Range(Worksheets("Breaking_Data").Range("M5:R5"), Worksheets("Breaking_Data").Range("M5:R5").End(xlDown)).Copy

    On Error GoTo Err_Execute

ActiveSheet.Range("A13").Rows("1:1").Insert Shift:=xlDown

    Range(Worksheets("Breaking_Data").Range("M5:R5"), Worksheets("Breaking_Data").Range("M5:R5").End(xlDown)).ClearContents

Next cell
 
You can use something like below.

Code:
Worksheets("Breaking_Data").Range("M5:R" & Worksheets("Breaking_Data").Cells(Rows.Count, "R").End(xlUp).Row)

This assumes you will have data in Column R when there is Data in column M. You can change Cells(Rows.Count, "R") to some other column as needed.
 
I find it a lot easier to separate the functions like below
I think it is a lot easier to read and understand

Code:
Dim LR As Long
LR=Worksheets("Breaking_Data").Cells(Rows.Count, "R").End(xlUp).Row
Worksheets("Breaking_Data").Range("M5:R" & LR)
[code]
 
Thank you so much, its work perfectly as i want. I need little bit more help for this Workbook, Here i have code to select source wb and then copy ws to Main WB. What i want to select source wb & then ws, then code find special header name and copy entire specific columns data form sheet to Main wb.
Header Name is "Name, Type, Date, Num, Item, Qty, Sale Price & Amount"

Code:
Private Sub browse_file_Click()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "RawData"
Set PasteSpecialFormatsStart = [RawData!A1]

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx), *.xlsm (*.xlsm),*.xls (*.xls),")

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(fileName:=FileToOpen)

    For Each Sheet In wb2.Sheets
        With Sheet.UsedRange
            .Copy PasteSpecialFormatsStart
            Set PasteSpecialFormatsStart = PasteSpecialFormatsStart.Offset(.Rows.Count)
        End With
       
    Next Sheet

End If

    wb2.Close
   
    'Delete Column for RawData in RawData Sheet
   
    Worksheets("RawData").Activate
    ActiveSheet.Range("C:C,E:E,G:G,I:I,K:K,M:M,O:O").Delete
   
    Worksheets("RawData").Range("B1:I1").Interior.Color = RGB(255, 192, 0)
    Worksheets("RawData").Rows(2).EntireRow.Delete
    Range("A1:G2").Interior.Color = RGB(255, 192, 0)
    'Dashboard Sheet Active
   
    Worksheets("PAKTURK DASHBOARD").Activate
   
    browse_file.BackColor = 500 'this is red
   
End Sub
 
Back
Top