[Solved] VBA Paste Special

RSntg

New member
Can someone help me check my code. When I run the macro no error is popping but the data is not pasting to the specific worksheet.


Option Explicit

Sub Get_TM1PLReports_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your TM1 PL Report & Import Range", FileFilter:="Excel Files (*xls*), *xls*, Text Files (*.TXT), *.txt, All Files (*.*), *.*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("F:L").Delete
OpenBook.Sheets(1).Range("E56:AC150").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B1").PasteSpecial xlPasteAllUsingSourceTheme
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
 
Can someone help me check my code. When I run the macro no error is popping but the data is not pasting to the specific worksheet.


Option Explicit

Sub Get_TM1PLReports_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your TM1 PL Report & Import Range", FileFilter:="Excel Files (*xls*), *xls*, Text Files (*.TXT), *.txt, All Files (*.*), *.*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("F:L").Delete
OpenBook.Sheets(1).Range("E56:AC150").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B1").PasteSpecial xlPasteAllUsingSourceTheme
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
Hello RSntg,

Please check the following things first:
  • Ensure "Sheet1" exists in the destination workbook.
  • Ensure there is no data in the target range that might be causing conflicts.
  • Confirm the range "E56:AC150" contains data.
Then, you can use the updated code:

Code:
Option Explicit
Sub Get_TM1PLReports_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim DestSheet As Worksheet
  
    ' Turn off screen updating for performance
    Application.ScreenUpdating = False
  
    ' Prompt the user to select a file to open
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your TM1 PL Report & Import Range", _
                                             FileFilter:="Excel Files (*.xls*), *.xls*; *.xlsx; *.xlsm, Text Files (*.txt), *.txt, All Files (*.*), *.*")
    ' Check if the user selected a file
    If FileToOpen <> False Then
        ' Open the selected workbook
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
      
        ' Delete columns F to L in the first sheet of the opened workbook
        OpenBook.Sheets(1).Range("F:L").Delete
      
        ' Check if the range E56:AC150 contains data
        If Application.WorksheetFunction.CountA(OpenBook.Sheets(1).Range("E56:AC150")) > 0 Then
            ' Copy the range E56:AC150 from the opened workbook
            OpenBook.Sheets(1).Range("E56:AC150").Copy
          
            ' Set the destination sheet to "Sheet1" in the current workbook
            Set DestSheet = ThisWorkbook.Worksheets("Sheet1")
          
            ' Check if the destination sheet exists
            If Not DestSheet Is Nothing Then
                ' Paste the copied range into cell B1 of the destination sheet
                DestSheet.Range("B1").PasteSpecial xlPasteAllUsingSourceTheme
            Else
                MsgBox "Sheet1 does not exist in the destination workbook.", vbExclamation
            End If
          
            ' Clear the clipboard
            Application.CutCopyMode = False
        Else
            MsgBox "The range E56:AC150 in the source workbook is empty.", vbExclamation
        End If
      
        ' Close the opened workbook without saving changes
        OpenBook.Close False
    Else
        MsgBox "No file was selected.", vbExclamation
    End If
  
    ' Turn on screen updating
    Application.ScreenUpdating = True
End Sub
 

Online statistics

Members online
0
Guests online
7
Total visitors
7

Forum statistics

Threads
352
Messages
1,541
Members
652
Latest member
William Tang
Back
Top