LinkBack URL
About LinkBacks
I'm trying to copy data from one sheet to another, but into columns arranged differently.
I just an subscript error?
Help is much appreciated
Please Login or Register to view this content.
I'm trying to copy data from one sheet to another, but into columns arranged differently.
I just an subscript error?
Help is much appreciated
Please Login or Register to view this content.
Last edited by KimK78; 09-19-2021 at 03:51 AM.
First, try adding
and delete (or just comment out)Please Login or Register to view this content.
It could be wiser to:Please Login or Register to view this content.
1) load whole range into array (in one operation, not in a loop)
2) process it (porbably fill the second array)
3) write whole result array in one operation into worksheet
Last edited by Kaper; 09-19-2021 at 08:37 AM.
Best Regards,
Kaper
Thanks Kasper, I'll test it out in the morning
Looking for your observations after testing.
If not everything is clear, see the yellow banner near the top of the page.
Working with sample data makes life much easier
Thanks Kaper, it works now:
Sub filtercopyrange()
Dim x As Long, cls
Dim DataArr() As String
Dim iCount As Integer
Dim rng1 As Range
Dim sh1 As Worksheet, sh2 As Worksheet
Dim fcol As Integer
Dim lcol As Integer
Dim valuee1 As Integer
Dim lRow2 As Long
Dim lRow1 As Long
Dim iCntr As Long
Dim i As Integer
Dim ct As Variant
Set sh1 = Sheets("Dataset")
Set sh2 = Sheets("Forside")
Sheets("Forside").Activate
Application.ScreenUpdating = False
Range("A7:Y5000").Clear
If IsNumeric(Range("D2").Value) = False Then
MsgBox "Vælg kontraktperiode først"
Exit Sub
Else
lRow2 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Dataset").Activate
valuee1 = Sheets("Forside").Range("D2").Value
iCount = 6
ReDim DataArr(1 To lRow2, 0 To 9)
For i = 2 To lRow2
ct = Range("L" & i).Value
If ct = valuee1 Then
iCount = iCount + 1
DataArr(i, 0) = Range("A" & i).Value2 'ID
DataArr(i, 1) = Range("D" & i).Value2 'Address
DataArr(i, 2) = Range("E" & i).Value2 'Number
DataArr(i, 3) = Range("F" & i).Value2 'Country
DataArr(i, 4) = Range("G" & i).Value2 'City
DataArr(i, 5) = Range("H" & i).Value2 'Zip
DataArr(i, 6) = Range("I" & i).Value2 'Product
DataArr(i, 7) = Range("J" & i).Value2 'Bandwidth
DataArr(i, 8) = Range("R" & i).Value2 'NRC
DataArr(i, 9) = Range("S" & i).Value2 'MRC
Sheets("Forside").Range("B" & iCount).Value2 = DataArr(i, 0) 'ID
Sheets("Forside").Range("C" & iCount).Value2 = DataArr(i, 1) 'Address
Sheets("Forside").Range("D" & iCount).Value2 = DataArr(i, 2) 'Number
Sheets("Forside").Range("G" & iCount).Value2 = DataArr(i, 3) 'Country
Sheets("Forside").Range("F" & iCount).Value2 = DataArr(i, 4) 'City
Sheets("Forside").Range("E" & iCount).Value2 = DataArr(i, 5) 'Zip
Sheets("Forside").Range("H" & iCount).Value2 = DataArr(i, 6) 'Product
Sheets("Forside").Range("I" & iCount).Value2 = DataArr(i, 7) 'Bandwidth
Sheets("Forside").Range("K" & iCount).Value2 = DataArr(i, 8) 'NRC
Sheets("Forside").Range("L" & iCount).Value2 = DataArr(i, 9) 'MRC
Else
End If
Next
Sheets("Forside").Activate
Application.ScreenUpdating = True
End If
End Sub
If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.
Also, you may not be aware that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks