CODEWITHSUNDEEP
vbaexcel
user9784229
user9784229

Reputation:

VBA Loop to Copy a Dynamic Range

I am attempting to create code in VBA that will cycle through a list of data, which changes weekly, and copies the data to another workbook. The number of columns will not change (A through E). There will always be five columns. However, the number of rows will change given the number of products sold. For each day of the week, the products sold is to be copied. I am still relatively new to VBA and haven't the slightest clue on how to set it up. This is the start of the code I was trying to write, but I have no clue what to do. Thanks in advance.

Sub ProdSold()

Dim T As Workbook
Dim Y As Workbook
Dim J As Integer
Dim V As Variant
Dim R As Range
Dim LastRow As Integer

J = InputBox("Please enter the number of products sold.")
LastRow = Range("A1").End(xlDown).Row

Set T = Workbooks.Open("Filename")
Set Y = ThisWorkbook

For X = 1 To LastRowX Step J
    V = Y.Sheets("Sheet1").Range("A" & X & ":" & "E" & J)
Next

End Sub

Upvotes: 0

Views: 1264

Answers (2)

QHarr
QHarr

Reputation: 84465

You can always define a dynamic named range in the workbook to copy from

e.g. press Ctrl + F3 to open the name manager window.

Add new name

Name: DynamicRange RefersTo: =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),5)

Then you simply do:

WorkbookNameToCopyFrom.Worksheets("Sheet1").Range("DynamicRange").Copy destinationCellAddressInOtherWorkbook

Change Sheet1 to the name of the sheet where you are copying the data from, WorkbookNameToCopyFrom to the workbook name you are copying from and destinationCellAddressInOtherWorkbook to the destination address e.g. ThisWorkbook.Worksheets("Sheet1").Range("A1")

Image:

Data

When you add new data to the source the dynamic named range automatically picks up the new rows and they get copied with the named range.

Upvotes: 0

Nandan Chaturvedi
Nandan Chaturvedi

Reputation: 1098

Here is how you can do it.

  1. If you do not have any restriction on the rows i.e You just want to copy complete Column range from one sheet to another, you can try:

I have written code on "Workbook.open". You can attach this to any other event. 

Private Sub Workbook_Open()

Dim currentWorkbook As Workbook
Dim bookToCopyFrom As Workbook

'## Open both workbooks first:
Set currentWorkbook = ThisWorkbook
Set bookToCopyFrom = Workbooks.Open("C:\Desktop\Book2.xlsx")

'Now, copy what you want from CurrentWorkbook:
currentWorkbook.Sheets("Sheet1").Range("A:E").Copy

'Now, paste to bookToCopyFrom worksheet:
bookToCopyFrom.Sheets("Sheet1").Range("A:E").PasteSpecial

'Close bookToCopyFrom:
bookToCopyFrom.Close

End Sub

  1. If you want to copy only till the rows where you have some delimiter i.e Copy all the rows until you find a delimiter ("*") in the row.

Sub copyWorkBook()


Dim i As Integer
Set currentWorkbook = ThisWorkbook
Set bookToCopyFrom = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")


i = 1

Do Until currentWorkbook.Sheets("Sheet1").Cells(i, 1).Value = ""                 'Copy until there is a blank space in the row(in this case end of entries
    
    'Copy each Column one by One
    
    bookToCopyFrom.Sheets("Sheet1").Cells(i, 1).Value = currentWorkbook.Sheets("Sheet1").Cells(i, 1).Value
    bookToCopyFrom.Sheets("Sheet1").Cells(i, 2).Value = currentWorkbook.Sheets("Sheet1").Cells(i, 2).Value
    
    bookToCopyFrom.Sheets("Sheet1").Cells(i, 3).Value = currentWorkbook.Sheets("Sheet1").Cells(i, 3).Value
    bookToCopyFrom.Sheets("Sheet1").Cells(i, 3).Value = currentWorkbook.Sheets("Sheet1").Cells(i, 4).Value
    bookToCopyFrom.Sheets("Sheet1").Cells(i, 4).Value = currentWorkbook.Sheets("Sheet1").Cells(i, 5).Value
    
    
    
    
    i = i + 1
        
    
Loop


End Sub

Kindly let me know if this helps you.

Upvotes: 1

Related Questions