Posts

Excel to notepad

Sub TestNotePad()     '// The range to copy - written freehand so change as needed     Range("A1:B55").Copy         '// Start Notepad with focus     Shell "notepad.exe", vbNormalFocus         '// Send the standard CTRL+V. Pastes to the     '// active window (Notepad, hopefully)     SendKeys "^V"     '// Back to the top of the file     SendKeys "^{HOME}"     End Sub ------------------- cebu1014 Author Commented: 2013-05-22 I got it to work using your above routine as a guide. I removed some of the lines though and added  TRUE at end of sendkeys command in order to get it to work. Sub CopyToNotepad()              Range("A1").Select     Range(Selection, Selection.End(xlDown)).Select     Selection.Copy       Shell "Notepad C:\Users\mw1\my Documents\abc.csv", vbNor...

Delete filter data except header

'Delete filter data except header Sub redfdf() Sheets(1).Range("a1").Select Selection.AutoFilter Sheets(1).UsedRange.AutoFilter Field:=2, Criteria1:="Income" Sheets(1).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Sheets(2).Range("A2") Sheets(1).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select Selection.EntireRow.Delete End Sub

CopyByHeader

Sub CopyByHeader()     Dim CurrentWS As Worksheet     Set CurrentWS = ActiveSheet     Dim SourceWS As Worksheet     Set SourceWS = Workbooks("Source.xlsx").Worksheets(1)     Dim SourceHeaderRow As Integer: SourceHeaderRow = 1     Dim SourceCell As Range     Dim TargetWS As Worksheet     Set TargetWS = Workbooks("Business Loader V7.1.xlsx").Worksheets(2)     Dim TargetHeader As Range     Set TargetHeader = TargetWS.Range("A1:AX1")     Dim RealLastRow As Long     Dim SourceCol As Integer     SourceWS.Activate     For Each Cell In TargetHeader         If Cell.Value <> "" Then             Set SourceCell = Rows(SourceHeaderRow).Find _                 (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)           ...

Copy to another book

sub ds() mypath = ThisWorkbook.Path & "\1.RAWFILES\" myfile = Dir(mypath & "ad*.csv")   Workbooks.Open Filename:=mypath & myfile, ReadOnly:=False   Set mywbk1 = ActiveWorkbook   mywbk1.Activate   Sheets(1).Select Range("a1").CurrentRegion.Copy mywbk.Sheets("ad).Range("a1") mywbk1.Close SaveChanges:=False end sub

In this Example I am Copying the File From "s" Folder to "sd" Folder

'In this Example I am Copying the File From "s" Folder to "sd" Folder Sub sbCopyingAFile() 'Declare Variables Dim FSO Dim sFile As String Dim sSFolder As String Dim sDFolder As String 'This is Your File Name which you want to Copy sFile = "Sample.xls" 'Change to match the source folder path sSFolder = "C:\s\" 'Change to match the destination folder path sDFolder = "D:\sd\" 'Create Object Set FSO = CreateObject("Scripting.FileSystemObject") 'Checking If File Is Located in the Source Folder If Not FSO.FileExists(sSFolder & sFile) Then MsgBox "Specified File Not Found", vbInformation, "Not Found" 'Copying If the Same File is Not Located in the Destination Folder ElseIf Not FSO.FileExists(sDFolder & sFile) Then FSO.CopyFile (sSFolder & sFile), sDFolder, True MsgBox "Specified File Copied Successfully", vbInformation, "Done!"...

Coping different block in excel

Sub testd() Sheets(1).Select Sheets(1).Range("a1").CurrentRegion.Select Selection.Copy Sheets(2).Range("a1") Sheets(2).Select a = Range("A1").CurrentRegion.Columns.Count k = 1 l = 1 Columns(a).Select Selection.Delete shift:=xlToLeft For i = 3 To a Sheets(2).Select     Rows("2:2").Select     Selection.AutoFilter     ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=">=0.04", Operator:=xlOr, Criteria2:="<=-0.04" ActiveSheet.Columns("a:C").Copy Sheets(3).Cells(k, l) 'l = Sheets(3).Range("a" & l).CurrentRegion.Columns.Count l = Sheets(3).UsedRange.Columns.Count l = l + 2 Sheets(2).Select Selection.AutoFilter Sheets(2).Columns("C").Select Selection.Delete shift:=xlToLeft Next End Sub

Example copies worksheets Sheet1, Sheet2 and Sheet4 to a new blank bk

This example copies worksheets Sheet1, Sheet2 and Sheet4 to a new blank workbook, then saves and closes the new workbook. VB Copy Worksheets(Array("Sheet1", "Sheet2", "Sheet4")).Copy With ActiveWorkbook      .SaveAs Filename:=Environ("TEMP") & "\New3.xlsx", FileFormat:=xlOpenXMLWorkbook      .Close SaveChanges:=False End With