Error executing vba code

[sofas]

Hello. I am trying to copy data from several specific sheets to the main one using the following code, but I am facing a problem that it copies the data and empties it at the same time. I do not know what to do.

Sub EssaiFiltreArrayClé()
Dim f As Variant

Dim ws As Worksheet:  Set ws = Sheets("sh")
 
  Clé = ws.[a2]

Dim wsArray As Variant: wsArray = Array("Sheet1", "Sheet2", "Sheet4")
 
For Each f In Worksheets(wsArray)
Rng = f.Range("A2:G" & f.[A65000].End(xlUp).Row).Value
 
  For i = 1 To UBound(Rng)
    If Rng(i, 1) = Clé Then n = n + 1
  Next i
  j = 0
  Dim Tbl(): ReDim Tbl(1 To n, 1 To UBound(Rng, 2))
  For i = 1 To UBound(Rng)
    If Rng(i, 1) = Clé Then
    j = j + 1
    For k = 1 To UBound(Rng, 2): Tbl(j, k) = Rng(i, k)
    Next k
 
End If
   Next i
       ws.[d14].Resize(UBound(Tbl), UBound(Tbl, 2)) = Tbl

Next f
End Sub

 

[StephenCrump]

There are a few problems with your code. Try:

Sub EssaiFiltreArrayClé()
   
    Dim wsArray As Variant, Tbl() As Variant, Clé As Variant, rng As Variant
    Dim ws As Worksheet, f As Worksheet
    Dim i As Long, j As Long, N As Long, StartRow As Long
   
    wsArray = Array("Sheet1", "Sheet2", "Sheet4")
    StartRow = 14
    Set ws = Sheets("sh")
    Clé = ws.[a2]
       
    For Each f In Worksheets(wsArray)
        N = 0
        rng = f.Range("A2:G" & f.Range("A" & Rows.Count).End(xlUp).Row).Value
        ReDim Tbl(1 To UBound(rng), 1 To UBound(rng, 2))
        For i = 1 To UBound(rng)
            If rng(i, 1) = Clé Then
                N = N + 1
                For j = 1 To UBound(rng, 2)
                    Tbl(N, j) = rng(i, j)
                Next j
            End If
        Next i
        If N > 0 Then ws.Range("D" & StartRow).Resize(N, UBound(Tbl, 2)) = Tbl
        StartRow = StartRow + N
    Next f
   
End Sub

You could also do this by filtering on Clé. Then you don't need to loop through each line in the range/array.

 

[sofas]

There are a few problems with your code. Try:

Sub EssaiFiltreArrayClé()
   
    Dim wsArray As Variant, Tbl() As Variant, Clé As Variant, rng As Variant
    Dim ws As Worksheet, f As Worksheet
    Dim i As Long, j As Long, N As Long, StartRow As Long
   
    wsArray = Array("Sheet1", "Sheet2", "Sheet4")
    StartRow = 14
    Set ws = Sheets("sh")
    Clé = ws.[a2]
       
    For Each f In Worksheets(wsArray)
        N = 0
        rng = f.Range("A2:G" & f.Range("A" & Rows.Count).End(xlUp).Row).Value
        ReDim Tbl(1 To UBound(rng), 1 To UBound(rng, 2))
        For i = 1 To UBound(rng)
            If rng(i, 1) = Clé Then
                N = N + 1
                For j = 1 To UBound(rng, 2)
                    Tbl(N, j) = rng(i, j)
                Next j
            End If
        Next i
        If N > 0 Then ws.Range("D" & StartRow).Resize(N, UBound(Tbl, 2)) = Tbl
        StartRow = StartRow + N
    Next f
   
End Sub

You could also do this by filtering on Clé. The you don't need to loop through each line in the range/array.

Thank you, great job, I appreciate your help @StephenCrump