Sub all_col()
Workbooks("xlsb file").Worksheets("sheet name").Range("A1:CR1048576").Copy_
Workbooks("xlsx file").Worksheets("sheet name").Range("A1")

How do I write more efficient code to copy all the cell ranges from one worksheet to another within different workbooks.instead of using "A1:CR1048576" is there a better way?

CodePudding user response：

Try using the UsedRange property of the worksheet.

Sub all_col()
    wb1.Worksheets("sheet name").UsedRange.Copy _
        wb2.Worksheets("sheet name").Range("A1")
End Sub

CodePudding user response：

Copy Worksheet In Closed Workbook to Worksheet in ThisWorkbook

• The function is a sub converted to a function to return a boolean indicating whether it was successful i.e. whether no errors occurred.
• You could classify this code as an 'import operation': the source workbook is closed, while the destination workbook contains the code. With 'a few changes', you could rewrite this code as an 'export operation': the destination workbook is closed and the source workbook contains the code. Looking at the file extensions, it looks like you needed the latter.

Option Explicit

Sub WsToWsInThisWorkbookTEST()
    
    Dim GotCopied As Boolean: GotCopied = WsToWsInThisWorkbook( _
        "C:\Test\Test.xlsx", "Sheet1", "A1", "Sheet1", "A1")
    If Not GotCopied Then Exit Sub
    
    'Continue with your code e.g.:
    MsgBox "Worksheet got copied.", vbInformation

End Sub

Function WsToWsInThisWorkbook( _
    ByVal SourceFilePath As String, _
    Optional ByVal SourceSheetID As Variant, _
    Optional ByVal SourceFirstCell As String = "A1", _
    Optional ByVal DestinationSheetID As Variant = "Sheet1", _
    Optional ByVal DestinationFirstCell As String = "A1") _
As Boolean
    On Error GoTo ClearError
    Const ProcName As String = "WsToWsInThisWorkbook"

    ' Source
    
    If Len(Dir(SourceFilePath)) = 0 Then
        MsgBox "Source file '" & SourceFilePath & "' not found.", vbCritical
        Exit Function
    End If

    Dim swb As Workbook: Set swb = Workbooks.Open(SourceFilePath, True, True)
    Dim sws As Worksheet: Set sws = swb.Sheets(SourceSheetID)
    Dim srg As Range
    With sws.UsedRange
        Dim lcell As Range: Set lcell = .Cells(.Rows.Count, .Columns.Count)
        Set srg = sws.Range(SourceFirstCell, lcell)
    End With
    
    ' Destination.
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets(DestinationSheetID)
    Dim dfCell As Range: Set dfCell = dws.Range(DestinationFirstCell)
    
    ' Copy.
    
    srg.Copy dfCell
    
    WsToWsInThisWorkbook = True
    
ProcExit:
    On Error Resume Next
        If Not swb Is Nothing Then swb.Close SaveChanges:=False
    On Error GoTo 0
    Exit Function
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & Err.Description, _
        vbCritical, ProcName
    Resume ProcExit
End Function

CodePudding user response：

Most of the answers provided would work but UsedRange extends to formatting (see this epic thread] discussing best method to find last row).

If that were an issue, you could include these functions below your original macro and it will be the precise space to copy from:

Sub all_col()
Dim lastRow As Long, lastColumn As Long

With Workbooks("xlsb file").Worksheets("sheet name")

    lastRow = FindLastRowInSheet(.Range("A1"))
    lastColumn = FindLastColumnInSheet(.Range("A1"))
    
    
    .Range("A1").Resize(lastRow, lastColumn).Copy_
        Workbooks("xlsx file").Worksheets("sheet name").Range ("A1")

End With

End Sub


Function FindLastRowInRange(someColumns As Range) As Long
Const zFx = "=MAX(FILTER(ROW(????),NOT(ISBLANK(????)),0))"
   
   Dim tRng As Range, i As Long, tRow As Long, pRng As Range
   With someColumns.Worksheet
      Set tRng = Intersect(someColumns.EntireColumn, .UsedRange)
      
      For i = 1 To tRng.Columns.Count
         
         Set pRng = Intersect(tRng.Columns(i), _
         Range(.Rows(FindLastRowInRange   1), .Rows(.Rows.Count)))
         
         If Not pRng Is Nothing Then
            tRow = .Evaluate(Replace(zFx, "????", _
               pRng.Address, 1, -1))
         
            If tRow > FindLastRowInRange Then _
               FindLastRowInRange = tRow
            
         End If
      Next i
   End With
End Function

Function FindLastRowInSheet(anywhereInSheet As Range) As Long
      FindLastRowInSheet = FindLastRowInRange(anywhereInSheet.Worksheet.UsedRange)
End Function



Function findLastColumn(someRows As Range) As Long
Const zFx = "=MAX(FILTER(COLUMN(????),NOT(ISBLANK(????)),0))"
   
   Dim tRng As Range, i As Long, tRow As Long, pRng As Range
   With someRows.Worksheet
      Set tRng = Intersect(.UsedRange, someRows.EntireRow)
      
      For i = 1 To tRng.Rows.Count
         
       Set pRng = Intersect(tRng.Rows(i), Range(.Rows(.Columns.Count), .Rows(findLastColumn   1)))
         
         If Not pRng Is Nothing Then
            tRow = .Evaluate(Replace(zFx, "????", _
               pRng.Address, 1, -1))
         
            If tRow > findLastColumn Then _
               findLastColumn = tRow
            
         End If
      Next i
   End With
End Function


Function FindLastColumnInSheet(anywhereInSheet As Range) As Long
      FindLastColumnInSheet = findLastColumn(anywhereInSheet.Worksheet.UsedRange)
End Function