VBA Loop: start pasting only after certain rows

jefffMarch

New Member
Joined
Oct 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I have two sheets in a workbook, where the first sheet has a column which has a couple of teams. I created this script that loops through the columns on sheet 1, and copy the team name, and some data around it. Once copied, it activate sheet2, and paste the 3 columns copied from sheet1. Now, what I want is that it is about to paste on sheet2 in columnA for team A, instead of pasting starting at A1, I want it to start at A4 because there are some formula in the first few rows. The same should happen for team B, and C....Since this is happening in a loop, it was easy for me to make some mistakes which causes the pasting to have "offset" after each paste...Of course I don't want that. The skipping should happens only during the first paste, everything after should be fine (which my code can do by finding the last empty row and paste there). So how can I spike a few rows in a loop, and not repeat it again?
VBA Code:
Public Sub CopyRows()
    Sheets("Raw Data - Weekday").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 25).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column D
        ThisValue = Cells(x, 25).Value
        If ThisValue = "A Channel Support" Then
            'Cells(x, 16).Copy
            Range(Cells(x, 24), Cells(x, 26)).Copy
            Sheets("Data Table").Select
            'NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
            NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
            'NextRow = Cells(Rows.Count, 5).End(xlUp).Offset(21)
            'Cells(NextRow, 5).Offset(rowOffset:=21).Select
            Cells(NextRow, 3).Select
            ActiveSheet.Paste
            Sheets("Raw Data - Weekday").Select
        ElseIf ThisValue = "B Channel Enablment" Then
            Range(Cells(x, 24), Cells(x, 26)).Copy
            Sheets("Data Table").Select
            NextRow = Cells(Rows.Count, 9).End(xlUp).Row + 1
            Cells(NextRow, 9).Select
            ActiveSheet.Paste
            Sheets("Raw Data - Weekday").Select
         ElseIf ThisValue = "C Enterprise" Then
            Range(Cells(x, 24), Cells(x, 26)).Copy
            Sheets("Data Table").Select
            NextRow = Cells(Rows.Count, 15).End(xlUp).Row + 1
            Cells(NextRow, 15).Select
            ActiveSheet.Paste
            Sheets("Raw Data - Weekday").Select
        ElseIf ThisValue = "D Core Horizon" Then
            Range(Cells(x, 24), Cells(x, 26)).Copy
            Sheets("Data Table").Select
            NextRow = Cells(Rows.Count, 21).End(xlUp).Row + 1
            Cells(NextRow, 21).Select
            ActiveSheet.Paste
            Sheets("Raw Data - Weekday").Select
        ElseIf ThisValue = "E Salesforce" Then
            Range(Cells(x, 24), Cells(x, 26)).Copy
            Sheets("Data Table").Select
            NextRow = Cells(Rows.Count, 27).End(xlUp).Row + 1
            Cells(NextRow, 27).Select
            ActiveSheet.Paste
            Sheets("Raw Data - Weekday").Select
        End If
    Next x
End Sub
 

jefffMarch

New Member
Joined
Oct 15, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Ok, try
VBA Code:
Public Sub jefffMarch()
   Dim Ary As Variant
   Dim i As Long, UsdRws As Long
  
   Ary = Array("A Channel Support", 3, "B Channel Enablment", 9, "C Enterprise", 15, "D Core Horizon", 21, "E Salesforce", 27)
   With Sheets("Raw Data - Weekday").ListObjects("TicketAgingDetails")
      For i = 0 To UBound(Ary) Step 2
         .Range.AutoFilter 2, Ary(i)
         .AutoFilter.Range.Offset(1).Columns("A:C").Copy Sheets("Data Table").Cells(4, Ary(i + 1))
      Next i
      .AutoFilter.ShowAllData
   End With
End Sub
It is working blazing fast and exactly as need; Thank you very much
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,850
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,147,959
Messages
5,744,045
Members
423,843
Latest member
alex2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top