Hi All,
I am new to VBA. I want to create a VBA macro to copy three worksheets of the same workbook(closed workbook) except the first row and paste into 3 different .dbf files. Is there any way to do it. I have create a rough code. Any suggestions would be helpful.
Private Sub CommandButton1_Click()
Dim StrPath1 As String
Dim StrPath2 As String
Dim StrPath3 As String
Dim StrPath4 As String
Dim Tags As Workbook
Dim sheet1 As Variant
Dim sheet2 As Variant
Dim sheet3 As Variant
Dim dbConn1 As Object
Dim dbConn2 As Object
Dim dbConn3 As Object
'Define Paths and filenames
StrPath1 = "C:\Tags.xlsx"
StrPath2 = "C:\sheet1.dbf"
StrPath3 = "C:\sheet2.dbf"
StrPath4 = "C:\sheet3.dbf"
'Create Connection with the 3 DBFs
Set dbConn1 = CreateObject("ADODB.Connection")
dbConn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath2 & ";Extended Properties=dBASE IV;"
Set dbConn2 = CreateObject("ADODB.Connection")
dbConn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath3 & ";Extended Properties=dBASE IV;"
Set dbConn3 = CreateObject("ADODB.Connection")
dbConn3.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath4 & ";Extended Properties=dBASE IV;"
'Disable screen flickering.
Application.ScreenUpdating = False
'Open files
Set Workbook1 = Workbooks.Open(StrPath1)
'Clear Previous contents
sheet1.Worksheets("variable").Range("A2:T2").End(xlDown).Clear
sheet2.Worksheets("digalm").Range("A2:U2").End(xlDown).Clear
sheet3.Worksheets("trend").Range("A2:W2").End(xlDown).Clear
Tags.Worksheets("Sheet1").Range("A2").End(xlDown).End(xlToRight).Copy sheet1.Worksheets("Sheet1").Range("A2")
Tags.Worksheets("Sheet2").Range("A2").End(xlDown).End(xlToRight).Copy sheet2.Worksheets("Sheet1").Range("A2")
Tags.Worksheets("Sheet3").Range("A2").End(xlDown).End(xlToRight).Copy sheet3.Worksheets("Sheet1").Range("A2")
End Sub
I am new to VBA. I want to create a VBA macro to copy three worksheets of the same workbook(closed workbook) except the first row and paste into 3 different .dbf files. Is there any way to do it. I have create a rough code. Any suggestions would be helpful.
Private Sub CommandButton1_Click()
Dim StrPath1 As String
Dim StrPath2 As String
Dim StrPath3 As String
Dim StrPath4 As String
Dim Tags As Workbook
Dim sheet1 As Variant
Dim sheet2 As Variant
Dim sheet3 As Variant
Dim dbConn1 As Object
Dim dbConn2 As Object
Dim dbConn3 As Object
'Define Paths and filenames
StrPath1 = "C:\Tags.xlsx"
StrPath2 = "C:\sheet1.dbf"
StrPath3 = "C:\sheet2.dbf"
StrPath4 = "C:\sheet3.dbf"
'Create Connection with the 3 DBFs
Set dbConn1 = CreateObject("ADODB.Connection")
dbConn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath2 & ";Extended Properties=dBASE IV;"
Set dbConn2 = CreateObject("ADODB.Connection")
dbConn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath3 & ";Extended Properties=dBASE IV;"
Set dbConn3 = CreateObject("ADODB.Connection")
dbConn3.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & StrPath4 & ";Extended Properties=dBASE IV;"
'Disable screen flickering.
Application.ScreenUpdating = False
'Open files
Set Workbook1 = Workbooks.Open(StrPath1)
'Clear Previous contents
sheet1.Worksheets("variable").Range("A2:T2").End(xlDown).Clear
sheet2.Worksheets("digalm").Range("A2:U2").End(xlDown).Clear
sheet3.Worksheets("trend").Range("A2:W2").End(xlDown).Clear
Tags.Worksheets("Sheet1").Range("A2").End(xlDown).End(xlToRight).Copy sheet1.Worksheets("Sheet1").Range("A2")
Tags.Worksheets("Sheet2").Range("A2").End(xlDown).End(xlToRight).Copy sheet2.Worksheets("Sheet1").Range("A2")
Tags.Worksheets("Sheet3").Range("A2").End(xlDown).End(xlToRight).Copy sheet3.Worksheets("Sheet1").Range("A2")
End Sub