I am trying to modify the below code so that it will be able to copy from one workbook to another and paste in the first empty blank cell in column A. For example if I copy and paste from A1 to E18 from one workbook, I want to be able to modify the code so that it opens a second workbook and copies and pastes the code from A19 (the first blank cell in A). I am greener than green when it comes to VBA programming. I have looked at examples for similar situations but have not been able to figure out how to apply them to what I want to do. Thank you!
Option Explicit
Sub FreezerLogImport()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If
'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("A2:A5000").Copy
wsCopyTo.Range("A2:A5000").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wsCopyFrom.Range("B2:B5000").Copy
wsCopyTo.Range("B2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wsCopyFrom.Range("C2:C5000").Copy
wsCopyTo.Range("C2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wsCopyFrom.Range("D2:D5000").Copy
wsCopyTo.Range("D2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wsCopyFrom.Range("F2:F5000").Copy
wsCopyTo.Range("E2:E5000").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
' Turn off Selection of last column
Application.Selection = False
' Turn off CutCopyMode to prevent Clipboard message pop-up
Application.CutCopyMode = False
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
End Sub
.
Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
' Finds M. tuberculosis and nontuberculosis mycobacteria and replaces them with MTBC and NTM, respectively.
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sheet1 As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("M. tuberculosis", "Unidentified nontuberculosis mycobacteria (NTM)")
rplcList = Array("MTBC", "Unidentified NTM")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sheet1 In ActiveWorkbook.Worksheets
sheet1.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sheet1
Next x
End Sub
Related
So I have a code thats pasting data into an excel column, i'm then trying to loop through the data in that column and create a new sheet from data for every value in column B but it's stopping after completing this action once and not looping through the column.
Any ideas?
i = 4
Do While Cells(i, 2).Value <> ""
Worksheets("Front").Cells(5, 3).Value = Cells(i, 2)
Worksheets("Front").Select
Range("C2:M35").Select
Selection.Copy
Sheets("PlaceHolder").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Dim wks As Worksheet
Set wks = ActiveSheet
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = wks.Range("C5").Value
i = i + 1
Loop
"Cells" and "Range" in your code both refer to the ActiveWorksheet, which presumably starts out as Worksheets("Front"), then you change ActiveWorksheet to Worksheets("Placeholder") with the Worksheets("Placeholder").Select statement. I'm not sure if creating the new worksheet sets ActiveWorksheet to the new worksheet or not and I shouldn't have to know to make the code work. Instead of relying on the implicit reference to ActiveWorksheet, you should use explicit references like this.
'Style note: Always put Option Explict at the top of the module
'and declare all your variables at the top of the subroutine.
Dim wsFront As Worksheet
Dim wsPlaceholder As Worksheet
Dim wsNewSheet As Worksheet
Dim i As Integer
Set wsFront = Worksheets("Front")
Set wsPlaceholder = Worksheets("Placeholder")
i = 4
Do While wsFront.Cells(i, 2).Value <> ""
' Copy data from Worksheets("Front")
wsFront.Cells(5, 3).Value = Cells(i, 2)
wsFront.Select
wsFront.Range("C2:M35").Select
Selection.Copy
' Paste data to Worksheets("Placeholder")
wsPlaceholder.Select
wsPlaceholder.Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
' Copy Worksheets("Placeholder") to new worksheet
wsPlaceholder.Copy After:=Worksheets(Sheets.Count)
'Get a reference to the new worksheet
Set wsNewSheet = Worksheets(Worksheets.Count)
wsNewSheet.Name = wsPlaceholder.Range("C5").Value
i = i + 1
Loop
There's typically no need to select or activate anything when using VBA in Excel (despite what the macro recorder might try to suggest)
If you plan on doing much VBA work in Excel then this is highly-recommended reading:
How to avoid using Select in Excel VBA
Dim wsData As Worksheet, wsFront As Worksheet, wsPH As Worksheet, v
Dim wb As Workbook, i As Long
Set wb = ThisWorkbook
Set wsData = ActiveSheet 'or some other specific sheet
Set wsFront = wb.Worksheets("Front")
Set wsPH = wb.Worksheets("PlaceHolder")
i = 4
Do While wsData.Cells(i, 2).Value <> ""
v = wsData.Cells(i, 2).Value
wsFront.Cells(5, 3).Value = v
wsFront.Range("C2:M35").Copy
With wsPH.Range("C2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
wsPH.Copy After:=wb.Worksheets(Sheets.Count)
wb.Worksheets(Sheets.Count).Name = v
Loop
i want a macro to add a new sheet and use it to paste some tables, but i when i run the macro again i wanna use the same newly created sheet and not to add a new sheet everytime i run the macro. Can u help me?
I am using the code that folows:
Sub cria_relatorio()
Dim newS As Worksheet, currentS As Worksheet
Dim aba_anterior As Worksheet
lugarAnterior = Selection.Address
Set pos = ActiveSheet
Set currentWB = ThisWorkbook
Set currentS = currentWB.Sheets("fim")
currentS.Range("PRODUTOS").Select 'table that i wanna copy and paste(it changes the values)
Selection.Copy
Sheets("tabelas_por_produto").Activate
ActiveCell.End(xlUp).Offset(1, 0).Select
Range("A1").Activate
If ActiveCell.Value = "" Then
ElseIf Range("a1000").End(xlUp).Offset(2, 0) = "" Then
Range("a1000").End(xlUp).Offset(2, 0).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
End If
ActiveCell.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
ActiveCell.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
ActiveCell.PasteSpecial _
Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows("1:200").AutoFit
End Sub
Copy Versions of a Range One Below the Other
Copy the code into a standard module (e.g. Module1).
Carefully adjust the constants and the workbook if necessary.
It is assumed that PRODUTO is a defined
name of
a range, with workbook scope.
The Code
Option Explicit
Sub cria_relatorio()
' Define constants.
Const srcName As String = "fim"
Const tgtName As String = "tabelas_por_produto"
Const rngName As String = "PRODUTOS"
Const tgtFirst As String = "A1"
Const tgtOffset As Long = 2
Dim wb As Workbook: Set wb = ThisWorkbook
' Define Source Range.
Dim src As Range: Set src = wb.Names(rngName).RefersToRange
' Define Target worksheet.
Dim ws As Worksheet
On Error Resume Next
Set ws = wb.Worksheets(tgtName): GoSub NoWorksheet
On Error GoTo 0
' Define Target Cell.
Dim tgt As Range
Set tgt = ws.Columns(ws.Range(tgtFirst).Column) _
.Find("*", , xlValues, , , xlPrevious)
If tgt Is Nothing Then Set tgt = ws.Range(tgtFirst)
If tgt.Row < ws.Range(tgtFirst).Row Then Set tgt = ws.Range(tgtFirst)
Set tgt = tgt.Offset(tgtOffset)
' Do copy/paste.
src.Copy
With tgt.Resize(src.Rows.Count, src.Columns.Count)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
.Rows.AutoFit
End With
Exit Sub
NoWorksheet:
If Err.Number <> 0 Then
wb.Worksheets.Add
Set ws = ActiveSheet: ws.Name = tgtName
End If
Return
End Sub
I made this simple code, or at least tried. But I have one small problem.
When I type For I = 14 To 25 I don't really know what I'm doing. I have a sheet called "Master" and in the range K6:V6 I have every name of every sheet I want to go through. I would like to write something like this: For I = sheets("Master").range("K6:V6") But this does not work, anyone that can help to me to assign the "names" in this array to I?
The rest of the code works as it should, it could be optimized by not having "select" but I don't seem to be able to do it so I took the easy way out. Thank you for your help!
Dim I As Integer
For I = 14 To 25
If Sheets(I).Visible = False Then
'If sheet = Not visble
'-----------------------------------------------------------------------------------------------------
Sheets(I).Visible = True
AA = Sheets("Master").Range("K6").Value
Sheets(AA).Select
ActiveSheet.Unprotect
ActiveSheet.Range("C3:C120").Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("C6:C120").ClearContents
ActiveSheet.Range("L6:M117").ClearContents
ActiveSheet.Protect
Range("A1").Select
Sheets(I).Visible = False
'-----------------------------------------------------------------------------------------------------
Else:
'If sheet = visble
'-----------------------------------------------------------------------------------------------------
AA = Sheets("Master").Range("K6").Value
Sheets(AA).Select
ActiveSheet.Unprotect
ActiveSheet.Range("C3:C120").Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("C6:C120").ClearContents
ActiveSheet.Range("L6:M117").ClearContents
ActiveSheet.Protect
Range("A1").Select
'-----------------------------------------------------------------------------------------------------
End If
Next I
Each Worksheet in a file is held in the Worksheets collection. You can look at each worksheet in the collection in turn and act on it.
Sub Test()
Dim wrkSht As Worksheet
Dim shtMaster As Worksheet
Dim InList As Range
Dim VisibleSetting As Long
Set shtMaster = ThisWorkbook.Worksheets("Master") 'Reference to Master worksheet
'This will look at each worksheet in the worksheets collection and reference it with 'wrkSht'
For Each wrkSht In ThisWorkbook.Worksheets
'Look for the worksheet name in the K6:V6 range.
Set InList = shtMaster.Range("K6:V6").Find(wrkSht.Name, LookIn:=xlValues, LookAt:=xlWhole)
'If the name is found InList will not be nothing.
If Not InList Is Nothing Then
With wrkSht
VisibleSetting = .Visible 'Remember the visible setting.
.Visible = xlSheetVisible
.Unprotect
.Range("C3:C120").Copy
.Range("G3").PasteSpecial xlPasteValues
Union(.Range("C3:C120"), .Range("L6:M17")).ClearContents
.Visible = VisibleSetting 'Put the visible setting back.
.Protect
End With
End If
Next wrkSht
End Sub
Further reading:
ThisWorkbook
With...End With Statement
For Each...Next Statement
I am trying to create a macro that dublicates and renames a dashboard, but doesn't include references to other worksheets. So basically i need it to insert charts as "pictures" and cells as values.
Until now, I have finished the duplication, but it still refers back to other worksheets and hence change correspondingly to the original dashboard.
Here is my code so far:
Sub CopySheet()
Dim i As Integer, x As Integer
Dim shtname As String
i = Application.InputBox("How many copies of this dashboard do you need?", "Copy sheet", Type:=1)
For x = 0 To i - 1
Worksheets("Dashboard").Copy After:=Sheets(Sheets.Count)
shtname = InputBox("What do you want to name your new dashboard?")
ActiveSheet.Name = shtname
Next x
End Sub
if i understood your question you can try this example code where you get an picture as image and value without formula:
sub test()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "yourPath\"
sFile = sPath & "yuorFile.xlsx"
Set wb = Workbooks.Open(sFile)
Range("A1:B8").Select ' select my value range
Selection.Copy 'copy it
Windows("NameFileDestination").Activate 'destination copy value
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("yuorFile.xlsx").Activate 'active source file where there is the chart
ActiveSheet.ChartObjects("Graphic name").Activate
Application.CutCopyMode = False
ActiveChart.ChartArea.Copy ' copy chart like image
Windows("NameFileDestination").Activate
Range("D2").Select
'below there is in italian immagine change in image
ActiveSheet.PasteSpecial Format:="Immagine (PNG)", Link:=False, _
DisplayAsIcon:=False
ActiveWorkbook.Save
wb.Close
end sub
Hope this helps
in the main workbook I start a button that opens the second workbook, then go back to first workbook, copy a range of cells, then go to the second workbook (here it goes wrong) to paste
Sub Knop7_Klikken()
Dim TelStaat As Workbook
Dim Staat As Worksheet
Dim WicamStaat As Workbook
Dim Invoer As Worksheet
Dim Pathname As String
Dim Filename As String
Dim Value1 As String
'TelStaat = "Calculatie 2014 Nesting Wicam.xlsm"
Set TelStaat = ThisWorkbook
Value1 = "AN"
Pathname = "V:\\2013 Calculatie\"
Filename = "VPT.xlsm"
'when I use this it wil not open second macro
Application.EnableEvents = False
Workbooks.Open Filename:=Pathname & Filename
Worksheets("Invoer").Activate
TelStaat.Activate
Worksheets("Staat").Columns(3).Find(Value1).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 6).Select
Selection.Resize(, 6).Select
Selection.Copy
'here it goes wrong,
Set WicamStaat = ActiveWorkbook
Worksheets("Invoer").Activate
Range("A32").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.Calculation = True / xlAutomatic
End Sub
Windows("copyfromfile.xlsx").Activate 'Copy
Columns("A:H").Select
Selection.Copy
Windows("pastetofile.xlsx").Activate 'Paste
Columns("A:A").Select
Selection.Insert Shift:=xlToRight