Help with VBA code to copy data from multiple worksheets to another worksheet

[omk28]

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 10 worksheets total 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

 

[JLGWhiz]

See if this will work.

Sub omk28()
Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String
For i = 2 To 7
    With Sheets(i)
    lastRow = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
    If lastRow < 4 Then lastRow = 4
        For j = 5 To lastRow
            For col = 2 To 31
                If .Cells(j, col) <> "" Then
                    a = .Cells(1, 2)
                    b = .Cells(j, 1)
                    c = .Cells(j, col)
                    d = .Cells(3, col)
                        .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 If
            Next
        Next
    End With
Next
End Sub

 

[omk28]

Thank you JLGWhiz, for your efforts and input, I tried the given code, but it overrides the actual contents of the sheet instead of copying the values to new sheet.

See if this will work.

Sub omk28()
Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String
For i = 2 To 7
    With Sheets(i)
    lastRow = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
    If lastRow < 4 Then lastRow = 4
        For j = 5 To lastRow
            For col = 2 To 31
                If .Cells(j, col) <> "" Then
                    a = .Cells(1, 2)
                    b = .Cells(j, 1)
                    c = .Cells(j, col)
                    d = .Cells(3, col)
                        .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 If
            Next
        Next
    End With
Next
End Sub

 

[JLGWhiz]

My error, wasn't paying attention when I deleted the destination sheet. Try it now;

Sub omk28()
Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String
For i = 2 To 7
    With Sheets(i)
    lastRow = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
    If lastRow < 4 Then lastRow = 4
        For j = 5 To lastRow
            For col = 2 To 31
                If .Cells(j, col) <> "" Then
                    a = .Cells(1, 2)
                    b = .Cells(j, 1)
                    c = .Cells(j, 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
End Sub

 

[omk28]

Thank you so much, I just applied and it is working. Really thank you very much for your efforts and input, its hard to find words to say thanks. I just have one question, would it be possible to merge the 'Value = a' according to the number of rows of "Value = B". Hope these two images will help to understand the question properly

My error, wasn't paying attention when I deleted the destination sheet. Try it now;

Sub omk28()
Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String
For i = 2 To 7
    With Sheets(i)
    lastRow = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
    If lastRow < 4 Then lastRow = 4
        For j = 5 To lastRow
            For col = 2 To 31
                If .Cells(j, col) <> "" Then
                    a = .Cells(1, 2)
                    b = .Cells(j, 1)
                    c = .Cells(j, 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
End Sub

 

[JLGWhiz]

I probably could do it, but I would rather not. I'll let you handle the formatting of the data. Glad the code worked for you.
Maybe somebody more inclined than me will pick up on it. If not, try posting a new thread with the screen shots of your sheet and see if somebody will jump on it.

Regards, JLG

 

[omk28]

Thank you so much for your kind advice and really appreciate what you have already did. Since I am not an advance level user of VBA and was burning all day till you save my day. I will keep trying to get the required formatting and in the mean time will also try posting the problem.

Best Regards
OMK

I probably could do it, but I would rather not. I'll let you handle the formatting of the data. Glad the code worked for you.
Maybe somebody more inclined than me will pick up on it. If not, try posting a new thread with the screen shots of your sheet and see if somebody will jump on it.

Regards, JLG