Guidance required for VBA code to copy data from multiple worksheets to another worksheet

Question

Hi I have written below code to copy certain range of cells from one worksheet to another sheet named as "Report".

Sub sample()

Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String

With Sheets("Jack")
lastRow = .Range("A" & Rows.Count).End(xlUp).Row

If lastRow < 4 Then lastRow = 4

For i = 5 To lastRow
For col = 2 To 31
If .Cells(i, col) <> "" Then

a = .Cells(1, 2)
b = .Cells(i, 1)
c = .Cells(i, col)
d = .Cells(3, col)

With Sheets("Report")
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).Value = a
.Range("B" & .Range("B" & .Rows.Count).End(xlUp).Row + 1).Value = b
.Range("C" & .Range("C" & .Rows.Count).End(xlUp).Row + 1).Value = c
.Range("D" & .Range("D" & .Rows.Count).End(xlUp).Row + 1).Value = d
End With
End If
Next
Next

End With
End Sub

Above code works perfectly for copying data from single worksheet named as "Jack" but I am trying to get the data from other sheets as well. There are total 10 worksheets and I want to copy data from sheet2 to sheet7 and want to skip sheet1, sheet 8, 9, and 10. Any help for making a loop to copy data from selected sheets will be highly appreciated. Thank you

user2140261 user2140261 · Accepted Answer · 2013-06-04T19:33:44

If all the Data is the same then it should be as simple as Replacing your

With Sheets("Jack")

With

For x = 2 To 7

With Sheets(x)

And adding one more Next to the end.

So the complete code would look like:

Sub sample()


Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String

For x = 2 To 7

With Sheets(x)

lastRow = .Range("A" & Rows.Count).End(xlUp).Row

If lastRow < 4 Then lastRow = 4

For i = 5 To lastRow
For col = 2 To 31
If .Cells(i, col) <> "" Then

a = .Cells(1, 2)
b = .Cells(i, 1)
c = .Cells(i, col)
d = .Cells(3, col)

With Sheets("Report")
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).Value = a
.Range("B" & .Range("B" & .Rows.Count).End(xlUp).Row + 1).Value = b
.Range("C" & .Range("C" & .Rows.Count).End(xlUp).Row + 1).Value = c
.Range("D" & .Range("D" & .Rows.Count).End(xlUp).Row + 1).Value = d
End With
End If
Next
Next

End With
Next x

End Sub

Guidance required for VBA code to copy data from multiple worksheets to another worksheet

1 Answers