I have an excel file with .xls format and I want to export some sheets from that workbook to create a new workbook at specific location in .xlsx or .xlsm format.
Currently I have a macro which creates a new workbook but in the same format .xls and every time I change format in the macro and then run it. It generates a excel but when I try to open It gives me error that file format is not compatible.
( Also, I can't change format of the .xls file because it is linked to other tools)
Sub Macro20()
'
'check voor deleten links/indien ok verwijder dan onderstaande tekst :
' "Windows("dpm.xls").Activate" en start opnieuw
On Error Resume Next
b = Str(Month(Date))
If Len(b) > 2 Then m = Right(b, 2) Else m = "0" + Right(b, 1)
a = Str(Day(Date))
If Len(a) > 2 Then d = Right(a, 2) Else d = "0" + Right(a, 1)
y = Right(Str(Year(Date)), 2)
If m > "05" Then fy = y + 1 Else fy = y
fy = Str(fy)
If Len(fy) > 2 Then fy = Right(fy, 2) Else fy = "0" + Right(fy, 1)
' fname = "\\Laakdal-nss-02\shareddata\Shared.All\CSC\Distribution planning\DPM\FISC" + fy + "\" + m + y + "\" + d + m + ".xls"
' ActiveWorkbook.SaveAs Filename:=fname
' ActiveWindow.ScrollWorkbookTabs Position:=xlLast
fname1 = "T:\Apparel\20 Planning\20 Gegevens\60 Rapporten\DPM\FISC" + fy + "\" + m + y + "\" + d + m + ".xls"
ActiveWorkbook.SaveAs Filename:=fname1
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Overview").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Invul").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Outbound").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Inbound").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Pickpool").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Inventory").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Samples").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("data").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("ART").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("copy").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Safety").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("check").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("info").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("VAS").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Checklist WE").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("insert workday").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("info1").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("makecopy").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("data").Select
Cells.Select
Range("G108").Activate
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("ART").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("copy").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Safety").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("check").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("info").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("VAS").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Checklist WE").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("insert workday").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("info1").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("makecopy").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("makecopy2").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("dayswork").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Safety").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Inventory").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.SmallScroll ToRight:=-8
Sheets("launch").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.SmallScroll ToRight:=-8
Sheets("Safety").Select
ActiveWindow.SmallScroll Down:=-23
ActiveWindow.SmallScroll ToRight:=-6
Sheets("Meas").Select
ActiveWindow.SmallScroll Down:=-23
ActiveWindow.SmallScroll ToRight:=-11
Sheets("AST").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.SmallScroll ToRight:=-6
Sheets("PickPool").Select
ActiveWindow.SmallScroll Down:=-23
ActiveWindow.SmallScroll ToRight:=-9
Sheets("Outbound").Select
ActiveWindow.SmallScroll Down:=-32
ActiveWindow.SmallScroll ToRight:=-6
Sheets("Inbound").Select
ActiveWindow.SmallScroll Down:=-23
ActiveWindow.SmallScroll ToRight:=-7
Sheets("Overview").Select
ActiveWindow.SmallScroll Down:=-75
ActiveWindow.SmallScroll ToRight:=-1
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Menu").Select
Sheets("Menu").Unprotect
ActiveWindow.TabRatio = 0.133
Range("J30:J32").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Shapes("AutoShape 32").Select
Selection.Cut
Range("D14").Select
Sheets("Menu").Protect
ActiveWorkbook.Save
fname = "\\Laakdal-nss-02\Shareddata\Shared.All\CSC\Distribution planning\Integrated Distribution Report\Input data\DPM Apparel.xlsx"
ActiveWorkbook.SaveAs Filename:=fname
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
ActiveWorkbook.SaveAs Filename:=fname1
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
End Sub
Related
I have a question about the macro that I am running. I want to copy / paste the values cross sheet, but the target sheet I want to compare the values and remove duplicates of intercalated columns.
So, the copy and paste is working well, but to comparing and removing duplicates is not working.
Is there something else that I should try in my Macro?
Sub GetInformation()
'
' Macro2 Macro
'
'some comments
Sheets("SpExtra").Select
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRToday").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("5lbExt").Select
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRInformationToday").Select
Range("D1").Select
ActiveSheet.Paste
Sheets("20LBExtra").Select
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRToday").Select
Range("G1").Select
ActiveSheet.Paste
Sheets("JRExtra").Select
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRToday").Select
Range("J1").Select
ActiveSheet.Paste
Sheets("SExtra").Select
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRToday").Select
Range("M1").Select
ActiveSheet.Paste
'some comments
Sheets("CRToday").Select
Range("J2:J4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("J3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRToday").Select
Range("A2:A12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRToday").Select
Range("M2:M4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("R3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRToday").Select
Range("D2:D14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("V3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRToday").Select
Range("D15:D27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("V17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRToday").Select
Range("G2:G10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CRSts").Select
Range("Z3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(10, 14, 18, 22, 26), Header _
:=xlYes
End Sub
Workbooks.Open Filename:="W:\MANUFACTURING\lppo\Emerging Markets\98-CMMS Forecast Reports\S2 - Ocean Containers Shipped\Data Files\UtilizationByLocation.xlsx"
ActiveWorkbook.Names.Add Name:="RecordCount", RefersToR1C1:="=Q_50_UtilizationByLocation_01_O!R1C100"
Range("CV1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(C[-99])"
RecordCount = Range("RecordCount")
Range("A2:G" & RecordCount).Select
'Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TC Containers Shipped Report Template.xlsm").Activate
Sheets("Utilization By Location").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
I am getting an error at Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
So I want to copy/paste fixed numbers in a different tab. I have one parameter (which is the period name) and based on the number the data should go to different rows. I prepared a code so far but it is so big! If you could advice of how I can reduce the lines that would be helpful. I have 12 periods but I just show you the first two as the rest are identical and I change only the row number.
Thanks so much in advance
If Range("D2") = 1 Then
Range("D10:E10").Select
Selection.Copy
Sheets(7).Select
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("G10:H10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("K10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("K10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("M10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("M10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("O10:S10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("O10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("V10:Z10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("V10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("D2") = 2 Then
Range("D11:E11").Select
Selection.Copy
Sheets(7).Select
Range("D11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("G11:H11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("G11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("K11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("K11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("M11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("M11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("O11:S11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("O11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(6).Select
Range("V11:Z11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(7).Select
Range("V11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End if
You don't need to select anything.
Dim row_offset As Long
row_offset = Sheets(6).Range("D2").Value - 1
Sheets(7).Range("D10:E10").Offset(row_offset, 0).Value = Sheets(6).Range("D10:E10").Offset(row_offset, 0).Value
Sheets(7).Range("G10:H10").Offset(row_offset, 0).Value = Sheets(6).Range("G10:H10").Offset(row_offset, 0).Value
Sheets(7).Range("K10").Offset(row_offset, 0).Value = Sheets(6).Range("K10").Offset(row_offset, 0).Value
Sheets(7).Range("M10").Offset(row_offset, 0).Value = Sheets(6).Range("M10").Offset(row_offset, 0).Value
Sheets(7).Range("O10:S10").Offset(row_offset, 0).Value = Sheets(6).Range("O10:S10").Offset(row_offset, 0).Value
Sheets(7).Range("V10:Z10").Offset(row_offset, 0).Value = Sheets(6).Range("V10:Z10").Offset(row_offset, 0).Value
I have 3 versions of a workbook, 1 has 4 tabs, one has 8, and one has 12. All tabs in the last one consist of the other two workbooks and the same for the second contains the first. What I need is for my macro to skip searching for the other 8/4 tabs in the earlier versions so that I do not have to click debug each time i have an old version of the workbook loading. I am VERY new to this, so any help would be great. Thank you in advance.
The error happens because the tab does not exist in certain versions of the workbook.
Sub TO_LOAD_OctDec()
' Macro to load data from workbook to master workbook.
'
' Open master database and prepare for transfer
Workbooks.Open Filename:="S:\Property & Casualty\PPE\Wildfires\California Wildfires 2017\Submissions\CWF2017-MasterDatabase.xlsx"
' Focus is given to workbook to obtain correct filename.
ActiveWindow.ActivatePrevious
Sheets("Ready").Select
Range("A9").Select
Selection.ClearContents
' Transfer company info
Application.GoTo Reference:="CoInfo"
Selection.Copy
ActiveWindow.ActivateNext
Sheets("CoInfo").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer personal property data
ActiveWindow.ActivatePrevious
Range("PersonalP").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer commercial property data
ActiveWindow.ActivatePrevious
Range("CommercialP").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer Auto data
ActiveWindow.ActivatePrevious
Range("Auto").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer Other Lines data
ActiveWindow.ActivatePrevious
Range("OtherLines").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer DF personal property data
ActiveWindow.ActivatePrevious
Range("DF_Residential").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer DF commercial property data
ActiveWindow.ActivatePrevious
Range("DF_Commercial").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer DF Auto data
ActiveWindow.ActivatePrevious
Range("DF_Auto").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer DF Other Lines data
ActiveWindow.ActivatePrevious
Range("DF_Other").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer MM Personal Property data
ActiveWindow.ActivatePrevious
Range("MM_Personal").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer MM Commercial Property data
ActiveWindow.ActivatePrevious
Range("MM_Commercial").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer MM Auto data
ActiveWindow.ActivatePrevious
Range("MM_Auto").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Transfer MM Other Lines data
ActiveWindow.ActivatePrevious
Range("MM_Other").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
' Save and close master database
Sheets("CoInfo").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
' TimeStamp
ActiveWindow.ActivateNext
Range("F11").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Here's a function to find out if a sheet exists:
Public Function HasSheet(SheetName As String) As Boolean
Dim i As Integer
Dim sheetNameUcase As String
sheetNameUcase = UCase(SheetName)
For i = 1 To Sheets.Count
If UCase(Sheets.Item(i).Name) = sheetNameUcase Then
HasSheet = True
Exit Function
End If
Next
HasSheet = False
End Function
Then use it like in this example:
' Transfer DF Auto data
If HasSheet("Data") Then
ActiveWindow.ActivatePrevious
Range("DF_Auto").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
End If
Also, avoid using On Error Resume Next. Essentially it disables all error trapping. It should be treated like an atomic bomb.
I want to transfer data that is in one column (D4:D21 on sheet 'dispersed') to the next empty row in another sheet (B$:N$ on 'sheet4'). Also in the A column on sheet4, I want the date that is in 'dispersed'!b4 I then want the original cells cleared (so that it can be filled out again in a month) and the workbook saved.
I recorded a macro to do this but it is very long. I also can't work out how to change it so that it fills the data on the next empty row as when I recorded the macro it lists the specific cells to paste to.
The end result in 'sheet4' should give me a running total of amounts paid.
Here is the macro that I recorded.
Sub Transfer_dispersments()
'
' Transfer_dispersments Macro
' Botton to transfer data from dispersment to totals
'
'
Range("D4").Select
Selection.Copy
Sheets("Sheet4").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dispersed").Select
Range("D4:D18").Select
Range("D18").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("B4").Select
Selection.Copy
Sheets("Sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Dispersed").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWorkbook.Save
End Sub
There are many ways of determining the "last row" of a worksheet. I used one method in the below code:
Sub Transfer_dispersments()
'
' Transfer_dispersments Macro
' Botton to transfer data from dispersment to totals
'
Dim newRow As Long
'Find last non-empty cell in column B
'(and then add 1 so that we point to the row we want to write to)
newRow = Sheets("Sheet4").Cells(Sheets("Sheet4").Rows.Count, "B").End(xlUp).Row + 1
'Copy values from D4:D18 on Dispersed sheet
' to Bx:Px on Sheet4 sheet
Sheets("Sheet4").Cells(newRow, "B").Resize(1, 15).Value = Application.Transpose(Sheets("Dispersed").Range("D4:D18").Value)
'Copy cell from B4 on Dispersed sheet
' to Ax on Sheet4 sheet
Sheets("Dispersed").Range("B4").Copy Sheets("Sheet4").Cells(newRow, "A")
'Clear contents of copied cells
Sheets("Dispersed").Range("D4:D18").ClearContents
Sheets("Dispersed").Range("B4").ClearContents
'Save workbook
ActiveWorkbook.Save
End Sub