Hi there, I need your assistance. I wrote some code and it copy pastes succesfully, however it goes line by line according to the if statement and takes a long long time.
Basically what I want is to copy the entire column of the source sheet (with entire column I mean the data that falls within the if statement) So for example all the data of July 2022 and nothing else.
I want to copy paste the columns B, D , E , H, V, X and AE to the destination sheet (which is a table) to the columns A, B , C , D, H, I , and N respectively.
The data must be appended to the last row of the destination table. And since the source sheet is also dynamic in range I need to find the last row too.
Below is the code I have for now. Some lines are being commented so don't pay attention to those. Any guidance is appreciated, many thanks!
Basically what I want is to copy the entire column of the source sheet (with entire column I mean the data that falls within the if statement) So for example all the data of July 2022 and nothing else.
I want to copy paste the columns B, D , E , H, V, X and AE to the destination sheet (which is a table) to the columns A, B , C , D, H, I , and N respectively.
The data must be appended to the last row of the destination table. And since the source sheet is also dynamic in range I need to find the last row too.
Below is the code I have for now. Some lines are being commented so don't pay attention to those. Any guidance is appreciated, many thanks!
VBA Code:
Sub Example()
Dim Last_Col As Long
Dim FoundDate As Range
Dim Last_Row As Long
Set wsDest = ThisWorkbook.Worksheets("ATP combi")
Set wsSource = ThisWorkbook.Worksheets("ATP-waarde bij inzet")
Dim lr As Long, r As Long
Dim tbl As ListObject
'Quit looping at the encounter of a blank cell with a forloop and finding the last row that contains data
Set tbl = wsDest.ListObjects("Tabel3")
Last_Row = wsDest.ListObjects("Tabel3").Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
MsgBox Last_Row
' For i = Last_Row To 1 Step -1
' If IsEmpty(wsDest.Cells(i, 1)) Then
' Last_Row = i
' Exit For
' End If
'Next
With wsSource
lr = .Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If IsDate(.Range("A" & r).value) Then
If Month(.Range("A" & r).value) = Month(Now()) - 1 And Year(.Range("A" & r).value) = Year(Now()) Then
Last_Row = Last_Row + 1
'wsDest.Range("A" & Last_Row & ":B" & Last_Row).value = wsSource.Range("A" & r & ":H" & r).value
wsDest.Range("A" & Last_Row).value = wsSource.Range("B" & r).value
wsDest.Range("B" & Last_Row).value = wsSource.Range("H" & r).value
wsDest.Range("C" & Last_Row).value = wsSource.Range("V" & r).value
wsDest.Range("D" & Last_Row).value = wsSource.Range("X" & r).value
wsDest.Range("H" & Last_Row).value = wsSource.Range("D" & r).value
wsDest.Range("I" & Last_Row).value = wsSource.Range("E" & r).value
wsDest.Range("N" & Last_Row).value = wsSource.Range("AE" & r).value
End If
End If
Next r
End With
End Sub
