\n
The code I am using so far :
\n Sub Fill_Tracker()\n\n ' Initialize the worksheets, number of rows per Offer and numbers of Offers\n Dim WSS As Worksheet\n Dim WSD As Worksheet\n Set WSS = Sheets("Database")\n Set WSD = Sheets("Data_PIVOT")\n' Copy and paste values of Currency BOQ\n WSS.Range("B10", WSS.Range("b10").End(xlDown)).Copy\n WSD.Range("J2").PasteSpecial xlPasteValues\n ' Copy and paste values of USD\n WSS.Range("c10", WSS.Range("c10").End(xlDown)).Copy\n WSD.Range("k2").PasteSpecial xlPasteValues\n ' Copy and paste values of USD/Wdc\n WSS.Range("d10", WSS.Range("d10").End(xlDown)).Copy\n WSD.Range("l2").PasteSpecial xlPasteValues\n ' Copy and paste values of Rate\n WSS.Range("e10", WSS.Range("e10").End(xlDown)).Copy\n WSD.Range("m2").PasteSpecial xlPasteValues\n ' Copy and paste values of Description\n WSS.Range("f10", WSS.Range("f10").End(xlDown)).Copy\n WSD.Range("n2").PasteSpecial xlPasteValues\n
\nThanks for all the help.
\n","author":{"@type":"Person","name":"Alessandro Peticchia"},"upvoteCount":0,"answerCount":1,"acceptedAnswer":null}}Reputation: 47
I am trying to do the following (please see the picture below): I have N categories in a worksheet (below just showing 2 as example), having 5 subcategories each category and I want to copy them in another worksheet but having only the subcategories, listing all the data from categories one below the others. How can I do that in VBA?
The code I am using so far :
Sub Fill_Tracker()
' Initialize the worksheets, number of rows per Offer and numbers of Offers
Dim WSS As Worksheet
Dim WSD As Worksheet
Set WSS = Sheets("Database")
Set WSD = Sheets("Data_PIVOT")
' Copy and paste values of Currency BOQ
WSS.Range("B10", WSS.Range("b10").End(xlDown)).Copy
WSD.Range("J2").PasteSpecial xlPasteValues
' Copy and paste values of USD
WSS.Range("c10", WSS.Range("c10").End(xlDown)).Copy
WSD.Range("k2").PasteSpecial xlPasteValues
' Copy and paste values of USD/Wdc
WSS.Range("d10", WSS.Range("d10").End(xlDown)).Copy
WSD.Range("l2").PasteSpecial xlPasteValues
' Copy and paste values of Rate
WSS.Range("e10", WSS.Range("e10").End(xlDown)).Copy
WSD.Range("m2").PasteSpecial xlPasteValues
' Copy and paste values of Description
WSS.Range("f10", WSS.Range("f10").End(xlDown)).Copy
WSD.Range("n2").PasteSpecial xlPasteValues
Thanks for all the help.
Upvotes: 0
Views: 98
Reputation: 42256
Please, try the next code. It should be very fast for a big range. It avoids iteration between each row, it uses arrays and array slices:
Sub Fill_Tracker()
Dim WSS As Worksheet, WSD As Worksheet, lastRow As Long, lastCol As Long, lastR As Long
Dim arr, arrCateg, strC As String, strCol As String, i As Long, lastRWSD As Long, c As Long
Set WSS = Sheets("Database")
Set WSD = Sheets("Data_PIVOT")
lastRow = WSS.UsedRange.Rows.count 'maximum number of rows to be processed
lastCol = WSS.cells(2, WSS.Columns.count).End(xlToLeft).Column 'no of columns
lastRWSD = WSD.Range("A" & WSD.Rows.count).End(xlUp).row + 1 'last empty row
arr = WSS.Range("A3", WSS.cells(lastRow, lastCol)).Value 'put the sheet content in an array
c = 5 'a variable to increment in order to build the column to be copied headers
For i = 1 To UBound(arr, 2) Step 5
strC = Split(cells(1, i).Address, "$")(1) 'first column letter
strCol = strC & ":" & Split(cells(1, c).Address, "$")(1) 'string of involved columns letter
lastR = WSS.Range(strC & WSS.Rows.count).End(xlUp).row - 2 'last row for the above range
c = c + 5 'increment the columns range
'make a slice for the necessary array rows and columns!
arrCateg = Application.index(arr, Evaluate("row(1:" & lastR & ")"), Evaluate("COLUMN(" & strCol & ")"))
'drop the array at once:
WSD.Range("A" & lastRWSD).Resize(UBound(arrCateg), 5).Value = arrCateg
lastRWSD = WSD.Range("A" & WSD.Rows.count).End(xlUp).row + 1 'last row where next time the array will be dropped
Next
End Sub
Upvotes: 1