Deleting a Particular Column with IF Condition before Pasting

[madhuchelliah]

Hello Folks, Please go through the code i mentioned. The code is intended to copy all the sheets from source workbook and paste to another workbook's single sheet. My requirement is before pasting all the sheets it should look for E1 cell in all the sheets, IF the E1 cell is blank it should delete the entire column and then paste ELSE just copy paste all the sheet. Also if possible please add the the file open default location should be in desktop.



Sub Import()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Set PasteStart = [Sheet1!C2]

Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents

FileToOpen = Application.GetOpenFilename _
(Title:="Please Select Your File", _
FileFilter:="Report Files *.xlsx (*.xlsx),")

If FileToOpen = False Then
MsgBox "No XML Selected.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)

For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet

End If

wb2.Close
End Sub

 

[Fluff]

How about

Sub Import()

   Dim wb1 As Workbook
   Dim wb2 As Workbook
   Dim Ws As Worksheet
   Dim PasteStart As Range
   Dim FileToOpen As String
   
Application.ScreenUpdating = False

   Set wb1 = ActiveWorkbook
   Set PasteStart = wb1.Sheets("Sheet1").Range("C2")
   
   Sheets("Sheet1").Cells.ClearContents
   
   ChDrive "C:"
   ChDir "[COLOR=#ff0000]C:\Users\Fluff\Desktop\[/COLOR]"
   
   FileToOpen = Application.GetOpenFilename _
      (Title:="Please Select Your File", _
      FileFilter:="Report Files *.xlsx (*.xlsx),")
   
   If FileToOpen = False Then
      MsgBox "No XML Selected.", vbExclamation, "ERROR"
      Exit Sub
   End If
   Set wb2 = Workbooks.Open(FileName:=FileToOpen)
   
   For Each Ws In wb2.Worksheets
      If Ws.Range("E1") = "" Then Ws.Columns("E").Delete
      With Ws.UsedRange
         .copy PasteStart
         Set PasteStart = PasteStart.Offset(.Rows.Count)
      End With
   Next Ws
   
   wb2.Close
End Sub

Change the line in red, to match your default path

 

[madhuchelliah]

Hello Fluff, Thanks for the prompt response. I am getting error in the line "
If FileToOpen = False Then" I don't know what is the reason

 

[Fluff]

That line should be

If FileToOpen = "False" Then

Forgot the quotes.

 

[madhuchelliah]

Thanks Fluff its working like charm. One more obligation. Is it possible to ask the user to set the path whatever they required ?

 

[Fluff]

When the dialogue box appears, you can navigate to any folder you want. Whilst it is possible to have a getfolder dialogue, that still needs an initial path, so is probably no better.
If you want the default path to be the users desktop, try this

   ChDir "C:\Users\" & Environ("Username") & "\Desktop\"

 

[madhuchelliah]

When the dialogue box appears, you can navigate to any folder you want. Whilst it is possible to have a getfolder dialogue, that still needs an initial path, so is probably no better.
If you want the default path to be the users desktop, try this

   ChDir "C:\Users\" & Environ("Username") & "\Desktop\"

Thanks Fluff. You made my work simple.

 

[madhuchelliah]

Hello Fluff. Another issue popped up. Since we are deleting a column(Modifying the Workbook) and pasting. After pasting, when the workbook closes it is asking to save or don't save because of modification. Is there any option to save the document automatically before it closes? So that i wont get any popup while running the code sequences.

 

[Fluff]

Yup, simply add the word true to the last line of code

wb2.Close True

 

[madhuchelliah]

Hello Fluff, if possible please give solution for this thread
https://www.mrexcel.com/forum/excel-questions/1035018-multiplying-cell-base-adjacent-column.html