Change specific values (not all) in a VBA sub

[juscuz419]

I am trying really hard to teach myself VBA through trial and error. I have the following that is doing exactly what I want it to do. And I'm sure there is a much better and more elegant way to do it, but it does work.
What I cannot figure out is how to change move to the next row of both the source and target worksheets for the cells shown below in bold red font. This is the first of probably many things I ultimately want this sub to do so any help will be another learning tool for me.

Sub CopyValuesBetweenWorksheets()
Dim sourceWS As Worksheet
Dim targetWS As Worksheet

' Set the source and target worksheets
Set sourceWS = ThisWorkbook.Worksheets("MRC_4699A") ' eventually replace "MRC_4699A" with the next sheet with a name LIKE {"***_*****}
Set targetWS = ThisWorkbook.Worksheets("Daily Summary") '
' Copy values from specific cells in the source sheet
targetWS.Range("B21").Value = sourceWS.Range("f4").Value
targetWS.Range("c21").Value = sourceWS.Range("m4").Value
targetWS.Range("d21").Value = sourceWS.Range("q1").Value
targetWS.Range("f21").Value = sourceWS.Range("e18").Value
targetWS.Range("g21").Value = sourceWS.Range("f18").Value
targetWS.Range("h21").Value = sourceWS.Range("g18").Value
targetWS.Range("i21").Value = sourceWS.Range("h18").Value
targetWS.Range("E21").Value = ""
If sourceWS.Range("AB3").Value Or sourceWS.Range("AB4").Value = True Then
targetWS.Range("E21").Value = "Pickup/SUV"
End If

Dim nonBlankCount1 As Long
nonBlankCount1 = Application.WorksheetFunction.Count(sourceWS.Range("K18:M18"))
targetWS.Range("k21") = nonBlankCount1

Dim nonBlankCount2 As Long
nonBlankCount2 = Application.WorksheetFunction.Count(sourceWS.Range("N18"))
targetWS.Range("L21") = nonBlankCount2
If nonBlankCount2 = 1 Then
targetWS.Range("L21") = "yes"
End If

End Sub

 

[NoSparks]

Re: the code from post 8
without knowing what's not working can't help you.

When the procedure stopped at the STOP instruction and you then proceeded one line at a time using the F8 key
did any sheets satisfy the LIKE statement ?

 

[juscuz419]

The coded walked through all the ws in the wb and for each loop it made the source ws name the name of the sheet in that loop. only two of the sheets 5 sheets satisfy the pattern though

 

[CephasOz]

Basically I am pulling info for up to three rows on each timesheet and pasting them into a summary sheet, then going to the next timesheet and getting up to three rows and pasting them into the next rows on the summary and so on until I have gone through ALL the time sheets.

It would be helpful to have all of the information up front. How does the following code work for you?

Sub CopyValuesBetweenWorksheets()
    Const cstrTitle As String = "Copy Values"
    Const cstrLike As String = "[A-Z][A-Z][A-Z]_[0-9][0-9][0-9][0-9]"
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim loopWS As Worksheet
    Dim lngRow As Long
    Dim lngCol As Long
    Dim rngCell As Range
    Dim bolFmtOK As Boolean
    Dim lngPasteRow As Long
    '
    ' Set the target worksheet
    Set targetWS = ThisWorkbook.Worksheets("Daily Summary")
    lngPasteRow = 21
    ' Loop through the source worksheets
    For Each loopWS In ThisWorkbook.Worksheets
        bolFmtOK = False
        If (Left(UCase(loopWS.Name), 8) Like cstrLike) Then
            Select Case UCase(Mid(loopWS.Name, 9))
                Case "A", "D", "WG"
                    bolFmtOK = True
            End Select
        End If
        If bolFmtOK Then
            Set sourceWS = loopWS
            ' PUT YOUR PROCESSING CODE HERE
            With targetWS
                ' Copy values from specific cells in the source sheet
                targetWS.Range("B" & lngPasteRow).Value = sourceWS.Range("f4").Value
                targetWS.Range("c" & lngPasteRow).Value = sourceWS.Range("m4").Value
                targetWS.Range("d" & lngPasteRow).Value = sourceWS.Range("q1").Value
                '
                lngRow = 0
                For lngCol = 0 To 3 ' f21 to i21, e18 to h18
                    .Range("f" & lngPasteRow).Offset(lngRow, lngCol).Value = sourceWS.Range("e18").Offset(lngRow, lngCol).Value
                Next
                '
                Set rngCell = .Range("E" & lngPasteRow)
                If (sourceWS.Range("AB3").Value Or sourceWS.Range("AB4").Value) Then
                    rngCell.Value = "Pickup/SUV"
                Else
                    rngCell.ClearContents
                End If
                '
                .Range("K" & lngPasteRow).Value = Application.WorksheetFunction.Count(sourceWS.Range("K18:M18"))
                '
                Set rngCell = .Range("L" & lngPasteRow)
                rngCell.Value = Application.WorksheetFunction.Count(sourceWS.Range("N18"))
                If (rngCell.Value = 1) Then
                    rngCell.Value = "yes"
                End If
                lngPasteRow = lngPasteRow + 4
            End With
        End If
    Next loopWS
End Sub

 

[juscuz419]

This gets the data for only one row of source sheet of the when there are three, skips three rows on the summary and gets the same thing for the next source sheet. I think I am really close on a solution for all of this. I thank you for all of your suggestions. I have learned a great deal from just walking through you code and figuring out what you were doing. Thanks.

 

[NoSparks]

There is no solution in this thread.
You should at least give credit to DanteAmor for solving this in the other thread
and unmark your own posts as being solutions.

 

[juscuz419]

So I mark DanteAmor's post with the checkmark to give credit?

 

[juscuz419]

My apologies to the forum members. Not a frequent poster and did not know all of the rules. I have found and read them. I'll do better in future posts.