Good morning to you all,
For starters pardon my English (I’m French)…
I’m also a beginner in VBA ?
I’m trying a VBA code that would allow the following :
I have a worksheet containing several sheets, each containing a table.
In one sheet "TEST", I would like, on command, to group the data from several sheets as long as the data is selected by inputting an “x” in columns AK :
Sub bbbcd()
Sheets("SGL").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
Dim range1 As Range, range2 As Range, multiplerange As Range
Set range1 = Range("A" & ce.Row & ":D" & ce.Row)
Set range2 = Range("F" & ce.Row & ":K" & ce.Row)
Set multiplerange = Union(range1, range2)
multiplerange.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 1)
ce.Value = "ok"
End If
Next ce
End Sub
(the first line in "TEST" has headers)
However by asking to copy the entire line instead of multiple ranges of cells, I manage to have all the data related to "x" pasted (below with 2 sheets) :
Sub bbbc()
Sheets("SGL").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
ce.EntireRow.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ce.Value = "ok"
End If
Next ce
Sheets("BPO").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
ce.EntireRow.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ce.Value = "ok"
End If
Next ce
End Sub
What do you think ? I would very much appreciate your help !
Have a good day,
Pauline
For starters pardon my English (I’m French)…
I’m also a beginner in VBA ?
I’m trying a VBA code that would allow the following :
I have a worksheet containing several sheets, each containing a table.
In one sheet "TEST", I would like, on command, to group the data from several sheets as long as the data is selected by inputting an “x” in columns AK :
- If “x” is found in column AK, copy cells from the associated line and from columns A to D and F to K
- Paste in sheet “TEST” at the last line of the table and starting in column B
- Replace the “x” by “ok”
- Not yet in code because already to slow : copy in “TEST”, and in column A, the name of the sheet from which the data has been copied. There are up to 5 sheets from which data could be copied. For the moment I've only tried with one sheet ("SGL")
Sub bbbcd()
Sheets("SGL").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
Dim range1 As Range, range2 As Range, multiplerange As Range
Set range1 = Range("A" & ce.Row & ":D" & ce.Row)
Set range2 = Range("F" & ce.Row & ":K" & ce.Row)
Set multiplerange = Union(range1, range2)
multiplerange.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 1)
ce.Value = "ok"
End If
Next ce
End Sub
(the first line in "TEST" has headers)
However by asking to copy the entire line instead of multiple ranges of cells, I manage to have all the data related to "x" pasted (below with 2 sheets) :
Sub bbbc()
Sheets("SGL").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
ce.EntireRow.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ce.Value = "ok"
End If
Next ce
Sheets("BPO").Activate
For Each ce In ActiveSheet.Range("AK5:AK" & Cells(Rows.Count, 1).End(xlUp).Row)
If ce.Value = "x" Then
ce.EntireRow.Copy Destination:=Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ce.Value = "ok"
End If
Next ce
End Sub
What do you think ? I would very much appreciate your help !
Have a good day,
Pauline