0

I am new to VBA and I am trying to write some code to copy data from one worksheet to another one. I have checked various sites and tried to write the code, but until I always get an error. The setting is as follows:

I have various worksheets, most of them are worksheets based on different teams (I will call them Team-Worksheets), one sheet is the data I import from an external databank (I will call it Import-Worksheet).

The code should loop through all the Team-Worksheets and based on the Name of the Team, which is always located in Cell “A2” it should find all stories that belong to the team in the “Import-Worksheet”(comparing it with “Team Name Column”) and ONLY copy the “ID” located in the “ID Column” and paste it into the second row of “ID Column” of the ListObject 1 of the corresponding "Team-Worksheet". Then it should find the next ID of that Team in the “Import-Worksheet” and copy-paste it into the next row of ListObject 1(all sheets have multiple listobjects, with varying length and start points). After it went through all the rows it should continue with the next “Team-Worksheet”.

I am unsure if I should run a 1) "for-loop" + "for-loop" 2) “for-loop” + an “advanced-filter”, or 3) “for-loop” + “for-loop combined with index/match”?

I used if B4 = Epic Id Link as I don't want to apply this to all the worksheets

Example 1:

Sub AddContent()
Dim sht As Worksheet
Dim i As Variant
Dim x As Long
Dim y As Worksheet
Dim rw As Range

Application.ScreenUpdating = False
For Each sht In ThisWorkbook.Worksheets  
    sht.Activate         
    i = sht.Range("A2")
    Set y = ActiveSheet
    If sht.Range("B4").Value = "EPIC ID Link" Then
        
        Sheets("Jira Import").Select
        ' Find the last row of data
        FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
        ' Loop through each row
        For x = 5 To FinalRow
            ' Decide if to copy based on column D
            ThisValue = Cells(x, 19).Value
            If ThisValue = i Then
                Cells(x, 4).Copy
                y.ListObjects(1).ListColumns("US ID").Select
                NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(NextRow, 1).Select
                ActiveSheet.Paste
                Sheets("Jira Import").Select
            End If
        Next x
            
    End If
        
Next sht
Application.ScreenUpdating = True

End Sub

Example 2:

Sub AddContent()

Dim sht As Worksheet
Dim i As Variant
Dim rgData As Range, rgCriteria As Range, rgOutput As Range

Application.ScreenUpdating = False

For Each sht In ThisWorkbook.Worksheets
    
    sht.Activate

    Set i = ActiveSheet.Range("A2")
    If sht.Range("B4").Value = "EPIC ID Link" Then
        
        Set rgData = ThisWorkbook.Worksheets("Jira Import").Range("S5").CurrentRegion
        Set rgCriteria = i
        Set rgOutput = ActiveSheet.ListObjects(1).ListColumns("US ID").DataBodyRange
        rgData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rgOutput, Unique:=True
        
    End If
        
Next sht

Application.ScreenUpdating = True

End Sub

Solving this would save me plenty of manual work!

Community
  • 1
  • 1
Kitsune
  • 1
  • "I always get an error" - which error and on which line? – SJR Mar 10 '20 at 12:22
  • Hi thanks for your response. I receive the following errors:. ForExample 1: runtime error 438(Object doesn't support this property or method / Line= "y.ListObjects(1). ListColumns.....". For Example 2: Runtime error 13 (line= "Set rgOutput =....") – Kitsune Mar 10 '20 at 12:39
  • 1
    I would start by reading https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?r=SearchResults&s=1|196.4501 and adapting your code accordingly. That may resolve some problems. – SJR Mar 10 '20 at 13:05

0 Answers0