Dynamic copy range with vba

JoeyGaspard

New Member
Joined
Jul 22, 2019
Messages
38
Hi All, I have the code below in a spreadsheet that performs multiple functions. In the section "Copy BU 08 Data to Atlas Upload" it selects a sheet and a range and copies it, then paste it to another sheet, and that works fine, but I need it to be dynamic. This upload varies week to week, in other words, some weeks there could be 20 rows of data, some weeks it could be as many as 60? When there is nothing in the rows, it puts zero's in the sheet it copies to, and zeros make my upload bomb out. I also have a section of code at the very bottom that should delete any rows where cells in column B on the target sheet are blank, but it wont work if there is data in that row at all, if the whole row is blank, it works and will delete it. Please help! Thanks in advance

VBA Code:
'Remove all account numbers with Due to From in Description
Sub ProcessPayroll08()

With Sheets("PayrollReport")
        .AutoFilterMode = False
        With .Range("B1", .Range("B" & Rows.Count).End(xlUp))
            .AutoFilter 1, "*Due*"
            On Error Resume Next
            .Offset(1).SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
   
'Clear Payroll Data BU 08

  Sheets("BU08Data").Select
  Range("A2:G100").Select
  Selection.ClearContents
  Range("A2").Select


'Copy Data from Payroll Report to BU 08
Dim Ws As Worksheet

Set Ws = Worksheets("BU08Data")
With Worksheets("PayrollReport")
   .Range("A1:G1").AutoFilter 1, "08-*"
   .AutoFilter.Range.Offset(1).Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
   .AutoFilterMode = False
End With

'Copy BU 18 Data to Atlas Upload
Worksheets("BU08Data").Range("I2:T66").Copy
Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues

'Clear Clipboard
Application.CutCopyMode = False

'Delete Blank Rows if No Data in cells in Column B
On Error Resume Next

    Range("B17:B100").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("B17").Select
End Sub
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,512
Office Version
365
Platform
Windows
How about
VBA Code:
Sub JoeyGaspard()

   With Sheets("PayrollReport")
      .AutoFilterMode = False
      .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, "*Due*"
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
   
   'Clear Payroll Data BU 08
   
   Sheets("BU08Data").Range("A2:G100").ClearContents
   
   
   
   'Copy Data from Payroll Report to BU 08
   Dim Ws As Worksheet
   
   Set Ws = Worksheets("BU08Data")
   With Worksheets("PayrollReport")
      .Range("A1:G1").AutoFilter 1, "08-*"
      .AutoFilter.Range.Offset(1).Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilterMode = False
   End With
   
   'Copy BU 18 Data to Atlas Upload
   With Worksheets("BU08Data")
      .Range("I2:T" & .Range("I" & Rows.Count).End(xlUp)).Copy
      Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues
   End With
   
   'Clear Clipboard
   Application.CutCopyMode = False
   
   'Delete Blank Rows if No Data in cells in Column B
   Worksheets("GeneralJournal").Range("B17:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
   
End Sub
 

JoeyGaspard

New Member
Joined
Jul 22, 2019
Messages
38
How about
VBA Code:
Sub JoeyGaspard()

   With Sheets("PayrollReport")
      .AutoFilterMode = False
      .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, "*Due*"
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
  
   'Clear Payroll Data BU 08
  
   Sheets("BU08Data").Range("A2:G100").ClearContents
  
  
  
   'Copy Data from Payroll Report to BU 08
   Dim Ws As Worksheet
  
   Set Ws = Worksheets("BU08Data")
   With Worksheets("PayrollReport")
      .Range("A1:G1").AutoFilter 1, "08-*"
      .AutoFilter.Range.Offset(1).Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilterMode = False
   End With
  
   'Copy BU 18 Data to Atlas Upload
   With Worksheets("BU08Data")
      .Range("I2:T" & .Range("I" & Rows.Count).End(xlUp)).Copy
      Worksheets("GeneralJournal").Range("B17").PasteSpecial Paste:=xlPasteValues
   End With
  
   'Clear Clipboard
   Application.CutCopyMode = False
  
   'Delete Blank Rows if No Data in cells in Column B
   Worksheets("GeneralJournal").Range("B17:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
  
End Sub

For some reason, that added about 6000+ rows of blanks to the sheet I am pasting to :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,512
Office Version
365
Platform
Windows
In that case you column I has something in it down to that range.
What column can be used to determine the last row of data?
 

JoeyGaspard

New Member
Joined
Jul 22, 2019
Messages
38
In that case you column I has something in it down to that range.
What column can be used to determine the last row of data?
It needs to be column I, but I see nothing in that column past row 46?
 

JoeyGaspard

New Member
Joined
Jul 22, 2019
Messages
38
This may have something to do with it, not sure, it could be another issue altogether maybe, for some reason when it paste the data to the GeneralJournal sheet, it puts borders around every cell in H but only on the blank rows???
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,512
Office Version
365
Platform
Windows
That suggest that you have something else going on. Probably an change event.
 

JoeyGaspard

New Member
Joined
Jul 22, 2019
Messages
38
That suggest that you have something else going on. Probably an change event.
Ok, not sure what that is/could be, I will do some googling and see what I can figure out. Thank you as always for your help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,512
Office Version
365
Platform
Windows
If you right click on the GeneralJournal tab & select View code, is there anything in the code window that opens up?
Also on the BU08Data sheet select I2 & hit Ctrl + down arrow, where do you end up?
 

Forum statistics

Threads
1,089,217
Messages
5,406,916
Members
403,111
Latest member
Donbozone

This Week's Hot Topics

Top