Excel VBA Copy and Paste Range

Hi
May be?
Change to

 Range("H4").End(xlDown).Offset(1, 0).Select
    lr2 = Cells(Rows.Count, "h").End(xlUp).Row - 3
    lr = Cells(Rows.Count, "j").End(xlUp).Row - 3 - lr2
    'Find next blank row
    ActiveCell.FormulaR1C1 = "=-R[" & -lr2 & "] C &"""""
    Selection.Copy
    Selection.Resize(lr).Select
    ActiveSheet.Paste

Hi,

All the code below is included in Module6 of the attached copy of your modified Sample Workbook.

You can use 'PasteSpecial' to multiply everything in a range:

'Change From this:
''''    Range("H4").End(xlDown).Offset(1, 0).Select
''''    'Find next blank row
''''    ActiveCell.FormulaR1C1 = "=-R[-656]C"
''''    Range("H660").Select
''''    Selection.Copy
''''    'Insert formula to flip sign of debit entry

'To

    Dim myRange As Range
    
    Range("H4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Range("H4").End(xlDown).Offset(1, 0).Select
    'Find next blank row
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Set myRange = Selection   'Save the Destination Range
    Range("Z3").Value = -1    'Use any Unused Cell
    Range("Z3").Copy          'Put the Multiplier in the ClipBoard
    myRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationMultiply, SkipBlanks _
        :=False, Transpose:=False
            
    Columns("H:H").NumberFormat = "0.00_);(0.00)"   'Format the Column for consistency
  
    'Clear the Unused Cell
    Range("Z3").Value = ""
    
    'Clear Object Pointer
    Set myRange = Nothing

You did a nice job modifying code you got from the Macro recorder. The code can be made to run faster, by eliminating the 'Select' lines, and replacing 'Paste' with direct copy, especially since most of the time you are Pasting all 100,000+ lines in the Worksheet:

Sub Copy_Paste_Reclass_Tab_Alternate1()

  Dim wsSource As Worksheet
  Dim wsDestination As Worksheet
  
  Dim myDestinationRange As Range
  
  Dim iCellsInDestinationRange As Long
  Dim iCellsInSourceRange As Long
  Dim iLastRowUsedSource As Long
  Dim iLastRowUsedDestination As Long
  Dim iRowsInRange As Long
  Dim iColumnsInRange As Long
  
  Dim sRange As String
  
  
  'Create Worksheet Objects
  Set wsSource = Sheets("Combined Queries")
  Set wsDestination = Sheets("RECLASS")
  
  wsDestination.Range("D:D").NumberFormat = "@"                 'Format Column 'D' as Text to retain leading 'Single Quote' and 'Left Justification'
  wsDestination.Columns("H:H").NumberFormat = "0.00_);(0.00)"   'Format Column 'D' for consistency
  
  'Clear the Destination Worksheet Data Area
  sRange = "A4:K" & Rows.Count
  wsDestination.Range(sRange).ClearContents
  
  'Get the Last Row Used in the Source Worksheet
  iLastRowUsedSource = wsSource.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

  sRange = "K2:K" & iLastRowUsedSource
  iCellsInSourceRange = Range(sRange).Count
  
  wsDestination.Range("A4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  'wsDestination.Range("B4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value   'Not needed - Overwritten
  'wsDestination.Range("D4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value   'Not needed - Overwritten
  
  wsDestination.Range("B4").Resize(iCellsInSourceRange).Value = "'GAAP"
  wsDestination.Range("D4").Resize(iCellsInSourceRange).Value = "'01000"
  
  sRange = "M2:M" & iLastRowUsedSource
  wsDestination.Range("H4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  
  sRange = "E2:E" & iLastRowUsedSource
  wsDestination.Range("C4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  
  sRange = "F2:F" & iLastRowUsedSource
  wsDestination.Range("E4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  
  sRange = "G2:G" & iLastRowUsedSource
  wsDestination.Range("F4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  
  sRange = "N2:N" & iLastRowUsedSource
  wsDestination.Range("J4").Resize(iCellsInSourceRange).Value = wsSource.Range(sRange).Value
  
  'Get the Last Row Used in the Destination
  'Copy the top of Colums 'A thru G' to the 'Bottom'
  iLastRowUsedDestination = wsDestination.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  sRange = "A4:G" & iLastRowUsedDestination
  
  iRowsInRange = wsDestination.Range(sRange).Rows.Count
  iColumnsInRange = wsDestination.Range(sRange).Columns.Count
  wsDestination.Range("A4").Offset(iCellsInSourceRange).Resize(iRowsInRange, iColumnsInRange).Value = wsDestination.Range(sRange).Value

  
  'Copy the top of Colums 'J' to the 'Bottom'
  sRange = "J4:J" & iLastRowUsedDestination
  
  iRowsInRange = wsDestination.Range(sRange).Rows.Count
  iColumnsInRange = wsDestination.Range(sRange).Columns.Count
  wsDestination.Range("J4").Offset(iCellsInSourceRange).Resize(iRowsInRange, iColumnsInRange).Value = wsDestination.Range(sRange).Value

  
  
  'Copy Destination 'Column H' Top to Destination Column 'H Bottom'
  sRange = "H4:H" & iLastRowUsedDestination
  iCellsInDestinationRange = Range(sRange).Count
  iRowsInRange = wsDestination.Range(sRange).Rows.Count
  iColumnsInRange = wsDestination.Range(sRange).Columns.Count
  Set myDestinationRange = wsDestination.Range("H4").Offset(iCellsInDestinationRange).Resize(iRowsInRange, iColumnsInRange)
  myDestinationRange.Value = wsDestination.Range(sRange).Value
  
  'Change the Sign in the bottom Half of Column 'H'
  Range("Z3").Value = -1    'Put Minus 1 '-1' in any Unused Cell
  Range("Z3").Copy          'Put the Multiplier in the ClipBoard
  myDestinationRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationMultiply, SkipBlanks:=False, Transpose:=False
            
  
  'Clear the Unused Cell
  Range("Z3").Value = ""
      
  'Clear Object Pointers
  Set wsSource = Nothing
  Set wsDestination = Nothing
  
  Set myDestinationRange = Nothing
  
End Sub

Sub DuplicateARangeOfValues(wsSource As Worksheet, wsDestination As Worksheet, sSourceRange As String, sDestinationStartAddress As String)

  Dim myDestinationRange As Range

  Dim iColumnsInSourceRange As Long
  Dim iRowsInSourceRange As Long
  
  'Get the Number of Rows and Columns in the Source Range
  iRowsInSourceRange = wsSource.Range(sSourceRange).Rows.Count
  iColumnsInSourceRange = wsSource.Range(sSourceRange).Columns.Count
  
  'Create the Destination Range with the same number of Rows and Columns as the 'Source Range'
  '  Resize resizes the range to the Number of Rows and Columns in the Resize Parameter
  wsDestination.Range(sDestinationStartAddress).Resize(iRowsInSourceRange, iColumnsInSourceRange).Value = wsSource.Range(sSourceRange).Value

  'Clear Object Pointer
  Set myDestinationRange = Nothing

End Sub

The above code works fine, but is not very maintainable (i.e. easy to make a mistake when modifying). The following code is a little easier to maintain:

Sub Copy_Paste_Reclass_Tab_Alternate2()

  Dim wsSource As Worksheet
  Dim wsDestination As Worksheet
  
  Dim myDestinationRange As Range
  
  Dim iLastRowUsedSource As Long
  Dim iLastRowUsedDestination As Long
  Dim iRowsInRange As Long
  Dim iRowsInSourceRange As Long
  Dim iColumnsInRange As Long
  
  Dim sRange As String
  Dim sSourceRange As String
  Dim sFirstDestinationCell As String
  
  
  'Create Worksheet Objects
  Set wsSource = Sheets("Combined Queries")
  Set wsDestination = Sheets("RECLASS")
  
  wsDestination.Range("D:D").NumberFormat = "@"                 'Format Column 'D' as Text to retain leading 'Single Quote' and 'Left Justification'
  wsDestination.Columns("H:H").NumberFormat = "0.00_);(0.00)"   'Format Column 'D' for consistency
  
  'Clear the Destination Worksheet Data Area
  sRange = "A4:K" & Rows.Count
  wsDestination.Range(sRange).ClearContents
  
  
  
  'Get the Last Row Used in the Source Worksheet
  iLastRowUsedSource = wsSource.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

  'Create Column 'A' on the Destination Sheet
  sSourceRange = "K2:K" & iLastRowUsedSource
  sFirstDestinationCell = "A4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Create Columns 'B' and 'D' on the Destination Sheet
  iRowsInSourceRange = Range(sSourceRange).Count
  wsDestination.Range("B4").Resize(iRowsInSourceRange).Value = "'GAAP"    'Resize expands the number of Rows in the Range
  wsDestination.Range("D4").Resize(iRowsInSourceRange).Value = "'01000"
  
  'Create Column 'H' on the Destination Sheet
  sSourceRange = "M2:M" & iLastRowUsedSource
  sFirstDestinationCell = "H4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Create Column 'C' on the Destination Sheet
  sSourceRange = "E2:E" & iLastRowUsedSource
  sFirstDestinationCell = "C4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Create Column 'E' on the Destination Sheet
  sSourceRange = "F2:F" & iLastRowUsedSource
  sFirstDestinationCell = "E4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Create Column 'F' on the Destination Sheet
  sSourceRange = "G2:G" & iLastRowUsedSource
  sFirstDestinationCell = "F4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Create Column 'J' on the Destination Sheet
  sSourceRange = "N2:N" & iLastRowUsedSource
  sFirstDestinationCell = "J4"
  Call DuplicateARangeOfValues(wsSource, wsDestination, sSourceRange, sFirstDestinationCell)
  
  
  'Get the Last Row Used in the Destination
  iLastRowUsedDestination = wsDestination.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
  'Copy the top of Columns 'A thru G' to the 'Bottom' on the Destination Worksheet
  'Create the Source Range
  'Copy the top of Columns 'A thru G' to the 'Bottom' on the Destination Worksheet
  sSourceRange = "A4:G" & iLastRowUsedDestination
  Call DuplicateARangeOfValuesDirectlyBelowOnTheSameWorksheet(wsDestination, sSourceRange)
  
    
  'Copy the top of Column 'J' to the 'Bottom' on the Destination Worksheet
  'Create the Source Range
  'Copy the top of Column 'J' to the 'Bottom' on the Destination Worksheet
  sSourceRange = "J4:J" & iLastRowUsedDestination
  Call DuplicateARangeOfValuesDirectlyBelowOnTheSameWorksheet(wsDestination, sSourceRange)
  
  
  'Copy the top of Column 'H' to the 'Bottom' on the Destination Worksheet
  'Create the Source Range
  'Copy the top of Column 'H' to the 'Bottom' on the Destination Worksheet
  sSourceRange = "H4:H" & iLastRowUsedDestination
  Call DuplicateARangeOfValuesDirectlyBelowOnTheSameWorksheet(wsDestination, sSourceRange)
  
  
  'Create the Destination Range for changing the Sign on the Bottom Half of Column 'H'
  iRowsInRange = wsDestination.Range(sSourceRange).Rows.Count
  iColumnsInRange = wsDestination.Range(sSourceRange).Columns.Count
  Set myDestinationRange = wsDestination.Range("H4").Offset(iRowsInRange).Resize(iRowsInRange, iColumnsInRange)
  
  'Change the Sign in the bottom Half of Column 'H'
  Range("Z3").Value = -1    'Put Minus 1 '-1' in any Unused Cell
  Range("Z3").Copy          'Put the Multiplier in the ClipBoard
  myDestinationRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationMultiply, SkipBlanks:=False, Transpose:=False
            
  'Clear the Unused Cell
  Range("Z3").Value = ""
      
      
  'Clear Object Pointers
  Set wsSource = Nothing
  Set wsDestination = Nothing
  
  Set myDestinationRange = Nothing
  
End Sub

Sub DuplicateARangeOfValues(wsSource As Worksheet, wsDestination As Worksheet, sSourceRange As String, sDestinationStartAddress As String)

  Dim myDestinationRange As Range

  Dim iColumnsInSourceRange As Long
  Dim iRowsInSourceRange As Long
  
  'Get the Number of Rows and Columns in the Source Range
  iRowsInSourceRange = wsSource.Range(sSourceRange).Rows.Count
  iColumnsInSourceRange = wsSource.Range(sSourceRange).Columns.Count
  
  'Create the Destination Range with the same number of Rows and Columns as the 'Source Range'
  '  Resize resizes the range to the Number of Rows and Columns in the Resize Parameter
  wsDestination.Range(sDestinationStartAddress).Resize(iRowsInSourceRange, iColumnsInSourceRange).Value = wsSource.Range(sSourceRange).Value

  'Clear Object Pointer
  Set myDestinationRange = Nothing

End Sub

Sub DuplicateARangeOfValuesDirectlyBelowOnTheSameWorksheet(wsDestination As Worksheet, sSourceRange As String)

  Dim myDestinationRange As Range

  Dim iRowsInSourceRange As Long
  
  Dim sFirstDestinationCell As String
  
  
  'Get the Number of Rows in the Source Range
  iRowsInSourceRange = wsDestination.Range(sSourceRange).Rows.Count
  
  'Get the Last Row Used in the Destination
  iLastRowUsedDestination = wsDestination.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
  'Get the Top Left Cell of the Destination Range
  sFirstDestinationCell = wsDestination.Range(sSourceRange).Offset(iRowsInSourceRange).Address
    
  'Duplicate the Range directly BELOW the Original Range
  'NOTE: Source and Destination Worksheets are both the Destination Worksheet
  Call DuplicateARangeOfValues(wsDestination, wsDestination, sSourceRange, sFirstDestinationCell)
  
  'Clear Object Pointer
  Set myDestinationRange = Nothing

End Sub

Lewis