change
xSheet = wbOpen.Worksheet(1)
Option Explicit
Private Sub CommandButton1_Click()
Dim FullFileName As String
FullFileName = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", _
1, "Custom Dialog Title", , False)
Workbooks.Open FullFileName
Dim wbOpen As Workbook
Set wbOpen = Workbooks.Open(FullFileName)
Dim xSheet As Worksheet
xSheet = wbOpen.Worksheet 'wrong here
Dim m As Integer
Dim n As Integer
m = xlCellTypeLastRow
n = xlCellTypeLastCol
With wbOpen
Dim X As Long
Dim Y As Long
X = xlCellTypeLastRow
Y = xlCellTypeLastCol
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim b As Integer
For i = 1 To X
Sheet2.Cells(i, 1) = xSheet(1).Cells(i, 1)
Sheet2.Cells(i, 2) = xSheet(1).Cells(i, 2)
Sheet2.Cells(i, 3) = xSheet(1).Cells(i, 3)
For a = 1 To m
If (Sheet1.Cells(a, 3) = xSheet.Cells(i, 1) And Sheet1.Cells(a, 4) = xSheet.Cells(i, 2) And Sheet1.Cells(a, 5) = xSheet.Cells(i, 3)) Then
b = a
Exit For
End If
Next a
Sheet2.Cells(i, 4) = Sheet1.Cells(a, 1)
Sheet2.Cells(i, 5) = Sheet1.Cells(a, 2)
Next i
End With
End Sub
Function xlCellTypeLastRow()
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
End With
xlCellTypeLastRow = LastRow
End Function
Function xlCellTypeLastCol()
Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
xlCellTypeLastCol = LastCol
End Function
Option Explicit
Private Sub CommandButton1_Click()
Dim FullFileName As String
FullFileName = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", _
1, "Custom Dialog Title", , False)
Workbooks.Open FullFileName
Dim wbOpen As Workbook
Set wbOpen = Workbooks.Open(FullFileName)
Dim xSheet1 As Worksheet
Dim xSheet2 As Worksheet
xSheet1 = wbOpen.Worksheets.Add
Dim m As Integer
Dim n As Integer
m = xlCellTypeLastRow
n = xlCellTypeLastCol
' With wbOpen
Dim X As Long
Dim Y As Long
X = xlCellTypeLastRow
Y = xlCellTypeLastCol
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim b As Integer
For i = 1 To X
xSheet1(2).Cells(i, 1) = xSheet1(1).Cells(i, 1)
xSheet1(2).Cells(i, 2) = xSheet1(1).Cells(i, 2)
xSheet1(2).Cells(i, 3) = xSheet1(1).Cells(i, 3)
For a = 1 To m
If (Sheet1.Cells(a, 3) = xSheet1(1).Cells(i, 1) And Sheet1.Cells(a, 4) = xSheet1(1).Cells(i, 2) And Sheet1.Cells(a, 5) = xSheet1(1).Cells(i, 3)) Then
b = a
Exit For
End If
Next a
xSheet(1).Cells(i, 4) = Sheet1.Cells(a, 1)
xSheet(1).Cells(i, 5) = Sheet1.Cells(a, 2)
Next i
' End With
End Sub
Function xlCellTypeLastRow()
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
End With
xlCellTypeLastRow = LastRow
End Function
Function xlCellTypeLastCol()
Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
xlCellTypeLastCol = LastCol
End Function
FullFileName = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", _
1, "Custom Dialog Title", , False)
Then in this excel file there are already three sheets. Sheet1 has data, I want to grab dat from sheet1 and write them to sheet2.Option Explicit
Private Sub CommandButton1_Click()
Dim FullFileName As String
Dim wbOpen As Workbook
Dim xSheet1 As Worksheet
Dim xSheet2 As Worksheet
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim b As Integer
Dim X As Long
Dim Y As Long
Dim m As Integer
Dim n As Integer
'Open a worksheet file based on user input
FullFileName = Application.GetOpenFilename("Excel files (*.xl*),*.xl*", 1, "Custom Dialog Title", , False)
Workbooks.Open FullFileName
Set wbOpen = Workbooks.Open(FullFileName) 'workbook has 3 sheets
m = xlCellTypeLastRow
n = xlCellTypeLastCol
X = xlCellTypeLastRow
Y = xlCellTypeLastCol
For i = 1 To X
wbOpen.Sheets(2).Cells(i, 1) = wbOpen.Sheets(1).Cells(i, 1)
wbOpen.Sheets(2).Cells(i, 2) = wbOpen.Sheets(1).Cells(i, 2)
wbOpen.Sheets(2).Cells(i, 3) = wbOpen.Sheets(1).Cells(i, 3)
For a = 1 To m
If (wbOpen.Sheets(1).Cells(a, 3) = wbOpen.Sheets(2).Cells(i, 1) And wbOpen.Sheets(1).Cells(a, 4) = wbOpen.Sheets(2).Cells(i, 2) And wbOpen.Sheets(1).Cells(a, 5) = wbOpen.Sheets(2).Cells(i, 3)) Then
b = a
Exit For
End If
Next a
wbOpen.Sheets(1).Cells(i, 4) = wbOpen.Sheets(2).Cells(a, 1)
wbOpen.Sheets(1).Cells(i, 5) = wbOpen.Sheets(2).Cells(a, 2)
Next i
' End With
End Sub
Function xlCellTypeLastRow()
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
End With
xlCellTypeLastRow = LastRow
End Function
Function xlCellTypeLastCol()
Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
xlCellTypeLastCol = LastCol
End Function
Title | # Comments | Views | Activity |
---|---|---|---|
Merging multiple rows to one | 22 | 35 | |
Delete rows if they are duplicates | 3 | 16 | |
Dynamic Vlookup Function Formula Help | 4 | 17 | |
Range Name from one WB to another...... Question | 9 | 11 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
13 Experts available now in Live!