(Solved) – Copy paste a specific range in every worksheet and paste that range into separate workbooks to be saved in a single folder

(solved)-–-copy-paste-a-specific-range-in-every-worksheet-and-paste-that-range-into-separate-workbooks-to-be-saved-in-a-single-folder
  1. this code works for copying all the data in the sheet into separate workbooks, I want to copy only a specific area from each sheet to separate workbooks.
  2. Before the IF statement, I put the following statement under the xWs.Copy, I specified the range as xWs.Range(“E2:G15”).Copy, the code doesn’t work. Kindly help me to solve or give me any hints. I am new to VBA. thank you very much

    Sub SplitWorkbook()
    
    Dim FileExtStr As String 
    Dim FileFormatNum As Long 
    Dim xWs As Worksheet 
    Dim xWb As Workbook 
    Dim FolderName As String
    
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = xWb.Path & "" & xWb.Name & " " & DateString
    MkDir FolderName
    
        For Each xWs In xWb.Worksheets
           xWs.Copy
         If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
                Else
                Select Case xWb.FileFormat
                Case 51:
                  FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                  If Application.ActiveWorkbook.HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
       xFile = FolderName & "" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
        Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
       Application.ActiveWorkbook.Close False
    Next
    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
    End Sub
    

Leave a Reply

Your email address will not be published. Required fields are marked *