Using VBA to copy data from one worksheet to a new one based on cell values-CodePudding

I'm just starting with VBA and I'm trying to play around a bit to see what I can do.

I'm trying to write a macro that auto-generates a report from a subsection of data on a main worksheet.

I want to only copy rows where the value in Column D is "China" AND the value in Column H is "HS". Also I'm only looking to copy data from a selection of the rows (A:C,E,F,G,I,Q,R,AF:AH,AN,AP,AQ).

So far I'm doing this by:

Creating a new sheet
Copying the title row
Searching for relevant data and copy/pasting into the new sheet

By following a few answers I found here and other forums, I put together the following. The top half works just fine (generating the sheet and copying the title row) but the main important part doesn't.

Forgive me if this is a Frankenstein job, I'm new here but trying to learn!

Option Explicit
Sub GenerateHSReport()

'Generating the sheet'

Sheets.Add(Count:=1).Name = "HS Report " & Format(Date, "DD-MM-YY")

'Adding the title row'

Sheets("SANBI - all bids").Range("A4:C4,E4,F4,G4,I4,Q4,R4,AF4:AH4,AN4,AP4,AQ4").Copy
Sheets("HS Report " & Format(Date, "DD-MM-YY")).Activate
Range("A1").Select
ActiveSheet.Paste

'Copying the HS data'

Dim srchtrm As String
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Dim i As Integer

With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
End With

Set shtSrc = Sheets("SANBI - all bids")
Set shtDest = Sheets("HS Report " & Format(Date, "DD-MM-YY"))
Set c = Range("A5:C5,E5,F5,G5,I5,Q5,R5,AF5:AH5,AN5,AP5,AQ5")
destRow = 2

Set rng = Application.Intersect(shtSrc.Range("D:D, H:H"), shtSrc.UsedRange)

For Each c In rng.Cells
If c.Value = "HS" And c.Value = "China" Then
            
c.Copy shtDest.Cells(destRow, 2)
          
destRow = destRow   1


End If
Next

With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
        
    Application.CutCopyMode = False

End Sub

Update Thanks commenters, it works! How exciting! FYI i had to add a line per each column I wanted to copy, as per below. Maybe it's a bit messy but it seems to work!


shtDest.Cells(destRow, 1).Value = Row.Columns("a").Value
shtDest.Cells(destRow, 2).Value = Row.Columns("b").Value
shtDest.Cells(destRow, 3).Value = Row.Columns("c").Value
'...etc'

CodePudding user response：

I'm on my phone so, I can'tvtest right now, but it should direct you in the right direction

Set rng = shtSrc.UsedRange
Dim row as range
For Each row In rng.rows
If row.columns("h").value = "HS" And row.columns("d").value = "China" Then
            
 shtDest.Cells(destRow, 2).value = Row.columns("b").value

destRow = destRow   1


End If
Next

Domething like that, you get the idea, again, it's not tested