Select each row and put in different sheet

Question

In function of the work in my column 2 I want to select the row and copy it in a sheet with the same name. All the time I run the code, a message 1004 error appear.

`Sub ventilation()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim LastRow As Integer
Dim dernierelilgne As Integer

Application.ScreenUpdating = False

' faire une boucle pour effacer les feuilles seelctionner'

For j = 1 To 9
    
    Sheets(j).Select
    LastRow = Range("A1000000").End(xlUp).Row
    For i = LastRow To 6 Step -1
        Sheets(j).Select
        Selection.Delete Shift:=xlUp
    Next i
    
    Sheets("source").Select
    derniereligne = Range("A1000000").End(xlUp).Row
      
      'en fonction du mot dans la colonne, envoyer vers la feuille correspondante'
    
    For k = 6 To derniereligne
    
        Sheets("source").Select
        If Sheets(j).Name = Cells(k, 2).Value Then
        
            Rows(k).Select
            Selection.Copy
            Sheets(j).Select
            LastRow = Range("A1000000").End(xlUp).Row + 1
            Cells(LastRow, 1).Select
            ActiveSheet.Paste
            
        End If
        
    Next k
    
Next j

Sheets("Source").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

If you have a solution, please !

Don't [Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba), and don't rely on [implicit references](https://stackoverflow.com/questions/17733541/why-does-range-work-but-not-cells) — Warcupine, Aug 30 '21 at 17:41
What is the `For i = LastRow To 6 Step -1` loop supposed to do ? Maybe `Sheets(j).Select` should be `Rows(i).Select` — CDP1802, Aug 30 '21 at 18:42
'for i= lastrow to 6 step -1' is suppose to loop to cleant it's sheet before put the new reference of the "source". — Cédric Coutant, Sep 03 '21 at 12:31

CDP1802 · Answer 1 · 2021-09-13T14:18:58.137

0

Without Select

Update 1 - LastRow changed to use UsedRange

Update 2 - Match column A

Sub ventilation()

    Dim ws As Worksheet, wsSrc As Worksheet, header As Range
    Dim i As Long, j As Long, k As Long
    Dim sName As String
    Dim LastRow As Long, derniereligne As Long

    Application.ScreenUpdating = False

    ' faire une boucle pour effacer les feuilles seelctionner'
    Set wsSrc = ThisWorkbook.Sheets("source")
    Set header = wsSrc.Range("A1:I1")
    derniereligne = wsSrc.Range("A" & Rows.Count).End(xlUp).Row

    For j = 1 To 9
        Set ws = ThisWorkbook.Sheets(j)
        sName = ws.Name
        
        LastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
        If LastRow >= 3 Then ws.Rows("3:" & LastRow).Delete
        LastRow = 3

        'en fonction du mot dans la colonne, envoyer vers la feuille correspondante'
        header.Copy ws.Range("A2")
        For k = 2 To derniereligne
            If wsSrc.Cells(k, "A").Value = sName Then
                wsSrc.Rows(k).Copy ws.Range("A" & LastRow)
                LastRow = LastRow + 1
            End If
        Next k
    Next j
    Application.ScreenUpdating = True
    MsgBox derniereligne - 1 & " rows scanned on worksheet " & wsSrc.Name, vbInformation
End Sub

edited Sep 13 '21 at 14:18

answered Aug 30 '21 at 18:54

CDP1802

13,871
2
7
17

thanks for your answers but et errase the first ligne and don't copy the row. Maybe it's because I don't understand your code. – Cédric Coutant Sep 03 '21 at 12:27
@Cédric What sheet number is `source` ? How many sheets in the workbook ? – CDP1802 Sep 03 '21 at 12:49
the sheet source is the last one and i have 10 sheets. – Cédric Coutant Sep 03 '21 at 19:19
@Cédric erase the first line on which sheet ? `ws.Rows("6:" & LastRow).Delete` deletes all the rows below row 5 on sheets 1 to 9. Note `dernierelilgne As Long` should be `derniereligne As Long` but that won't stop it working. – CDP1802 Sep 03 '21 at 19:36
he erase the sheet of every sheet (9) and i have already corret the fault `dernierelilgne` – Cédric Coutant Sep 04 '21 at 09:52
I don't really undestand the probleme but i need in the sheet except source, the sheet need to be erase before copy the ligne in source. The porbleme is in the code he erase all if I haven't any word in the colum A. – Cédric Coutant Sep 04 '21 at 10:05
i think i have correct the problem. I have move `Next j` to clear the sheet before copy. – Cédric Coutant Sep 04 '21 at 10:11
the other porblem is i don't understand how he can see the word in column A ? When I run the code he didn't execute the code `wsSrc.Rows(k).Copy ws.Range("A" & LastRow)` and `LastRow = LastRow + 1` – Cédric Coutant Sep 04 '21 at 10:21
@Cédric OK, I thought you had a header in line 5 so A5 wasn't blank. Is any column in row 5 not blank ? See updated code – CDP1802 Sep 04 '21 at 10:38
okai the code said he have scanne 13 row. And I have 17 rows. I don't understand your code, it's to hard for me. The previous code was more easy for me and in the first step clean all the sheet. But it doesn't copy line after line in the good sheet. (you can see the code under me message. – Cédric Coutant Sep 12 '21 at 10:28
I have post a picture because i'm not sure to explaine clearely. – Cédric Coutant Sep 12 '21 at 10:43
sure, I will put this sheet. – Cédric Coutant Sep 12 '21 at 20:16

Cédric Coutant · Answer 2 · 2021-09-12T20:18:26.727

0

Example

 Sub ventilation()

    Dim ws As Worksheet, wsSrc As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim sName As String
    Dim LastRow As Long, derniereligne As Long

    Application.ScreenUpdating = False

    ' faire une boucle pour effacer les feuilles seelctionner'
    Set wsSrc = ThisWorkbook.Sheets("source")
    derniereligne = wsSrc.Range("A" & Rows.Count).End(xlUp).Row

    For j = 1 To 9
        Set ws = ThisWorkbook.Sheets(j)
        sName = ws.Name
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Rows("2:" & LastRow).Delete
        LastRow = 2
    Next j
      'en fonction du mot dans la colonne, envoyer vers la feuille correspondante'
    
        For k = 2 To derniereligne
            If wsSrc.Cells(k, 2).Value = sName Then
                wsSrc.Rows(k).Copy ws.Range("A" & LastRow)
                LastRow = LastRow + 1
            End If
        Next k
    
    Application.ScreenUpdating = True
End Sub

edited Sep 12 '21 at 20:18

answered Sep 12 '21 at 10:35

Cédric Coutant

13
5

it clean the sheet 1 to 9 but don't copy the row in those sheet. – Cédric Coutant Sep 12 '21 at 10:36
You are matching column B with `wsSrc.Cells(k, 2).Value = sName` but screen shot shows sheet names in Column A. Also `Next j` should come be after `Next K`. I will update my answer. – CDP1802 Sep 13 '21 at 14:22
okai thank your fo mutch for your time. I don't understand entirely the code but it work now ! – Cédric Coutant Sep 15 '21 at 20:06

Select each row and put in different sheet

2 Answers2